Datum VBA

[Leonhard]

Hallo zusammen,

ich müsste im Blatt Tabelle1 in E13 ein Datum eingeben können.
Es gibt bereits einen Code der das Datum richtig verarbeiten würde, jetzt muss ich die Zelle E13 noch als V_Datum im Code definieren.. und scheitere kläglich..

Also der Ausdruck V_Datum wird bereits im Code verwendet, das würde ich ungerne alles umschreiben. Daher die Idee die Zelle E13 dann als V_Datum zu bezeichnen.

Beste Grüße
leo

[marose67]

Hallo,

ich abe das Gefühl, dass Du genauer werden musst:

Option Explicit

Sub Datum()
Dim V_Datum As Date
    V_Datum = Range("E13")
    MsgBox V_Datum
End Sub

Gruß
Marcus

[Leonhard]

Hallo Marcus,

Code:

If (V_Datum - 30 < DateValue(Workbooks(V_Quelle).Sheets(1).Cells(i, 7).Value) And DateValue(Workbooks(V_Quelle).Sheets(1).Cells(i, 7).Value) < V_Datum) Then
                 Workbooks(V_Ziel).Sheets(1).Cells(g, 6).Value = Workbooks(V_Quelle).Sheets(1).Cells(i, 9).Value
            End If

dieses V_Datum wurde früher über eine Userform abgefragt. Nach der Umstellung auf 365 klappt das allerdings nicht mehr..
Ich suche jetzt nach einer simplen Lösung dass der bestehende Code unberührt bleiben kann und ich einfach dieses Datum in eine Zelle eingeben kann und dieses dann wie V_Datum behandelt wird. 

Das steht oben im Modul

Code:

Public V_Datum As Date

Der Code lag hinter dem Button der UserForm nachdem auf "Übernehmen" geklickt hatte

Code:

Private Sub CommandButton1_Click()
    V_Datum = Me.DTPicker1.Value
   
    Me.Hide
End Sub

Kann man das so simpel umgestalten wie ich mir das vorstelle 

[schauan]

Hallöchen,

V_Datum als Zellbezeichnung hilft Dir da nicht unbedingt weiter, weil es einmal ein Bereichsname und einmal eine Variable ist. Du könntest das nur so verwenden:

Range("V_Datum").Value = V_Datum

Eine andere Variante wäre eine Objektvariable. Wichtig dabei ist die Dimensionierung als Range, ansonsten ist V_Datum einmal die Zelle und dann der String.

Dim V_Datum As Range
Set V_Datum = Range("A1")
V_Datum = "Monster"


(wobei ich bestimmt V_Datum.Value schreiben würde)

[Leonhard]

Hi =)

hmmm.. ich habe nach bestem Wissen und Gewissen versucht deinen Tipp umzusetzen.. erneut erfolglos  

Falls sich jemand erbarmen mag.. folgend der komplette Code 

Code:

Sub Auto_open()
    Dim dlgOpen     As FileDialog
    Dim strDatei    As String
   
    Dim V_Beleg As String
    Dim VDatum As Date


    Dim i As Long, j As Long, g As Integer, V_WE As String
   
    Dim V_Quelle As String, V_Ziel As String, V_Makro As String
   
    V_Makro = ActiveWorkbook.Name
   

   
    MsgBox ("Bitte wählen Sie die zu formatierende Liste aus.")
   
   
   
    Set dlgOpen = Application.FileDialog(msoFileDialogOpen)
   
    With dlgOpen

        .AllowMultiSelect = False
        .Show
        On Error Resume Next
        strDatei = .SelectedItems(1)

        On Error GoTo 0
    End With
    If strDatei <> "" Then
        Workbooks.Open Filename:=strDatei, UpdateLinks:=0
    End If
   
   
    V_Quelle = ActiveWorkbook.Name
   
     
       
    Workbooks.Add
    V_Ziel = ActiveWorkbook.Name
   
    g = 2
   
    For i = 2 To 50
        If (Workbooks(V_Makro).Sheets(1).Cells(i, 1).Value) = (Left(V_Quelle, 4)) Then
            V_WE = Workbooks(V_Makro).Sheets(1).Cells(i, 2).Value
        End If
    Next i
   
   
    Workbooks(V_Ziel).Sheets(1).Cells(1, 1).Value = "Text1"
    Workbooks(V_Ziel).Sheets(1).Cells(1, 2).Value = "Text2"
    Workbooks(V_Ziel).Sheets(1).Cells(1, 3).Value = "Text3"
    Workbooks(V_Ziel).Sheets(1).Cells(1, 4).Value = "Text4"
    Workbooks(V_Ziel).Sheets(1).Cells(1, 5).Value = "Text5"
    Workbooks(V_Ziel).Sheets(1).Cells(1, 6).Value = "Text6"
    Workbooks(V_Ziel).Sheets(1).Cells(1, 7).Value = "Text7"
    Workbooks(V_Ziel).Sheets(1).Cells(1, 8).Value = "Text8"
    Workbooks(V_Ziel).Sheets(1).Cells(1, 9).Value = "Text9"
   
                                                                                'Aufgliederung nach Fälligkeit (30-60-90)
    For i = 2 To 10000
        If Workbooks(V_Quelle).Sheets(1).Cells(i, 5).Value <> "" Then
            Workbooks(V_Ziel).Sheets(1).Cells(g, 1).Value = Left(V_Quelle, 4)
            Workbooks(V_Ziel).Sheets(1).Cells(g, 2).Value = V_WE
            Workbooks(V_Ziel).Sheets(1).Cells(g, 3).Value = Workbooks(V_Quelle).Sheets(1).Cells(i, 2).Value
            Workbooks(V_Ziel).Sheets(1).Cells(g, 4).Value = Workbooks(V_Quelle).Sheets(1).Cells(i, 9).Value
           
            Workbooks(V_Ziel).Sheets(1).Cells(g, 20).Value = Workbooks(V_Quelle).Sheets(1).Cells(i, 1).Value
           
            Workbooks(V_Ziel).Sheets(1).Cells(g, 5).Value = Workbooks(V_Quelle).Sheets(1).Cells(i, 7).Value
           
            If (V_Datum - 30 < DateValue(Workbooks(V_Quelle).Sheets(1).Cells(i, 7).Value) And DateValue(Workbooks(V_Quelle).Sheets(1).Cells(i, 7).Value) < V_Datum) Then
                 Workbooks(V_Ziel).Sheets(1).Cells(g, 6).Value = Workbooks(V_Quelle).Sheets(1).Cells(i, 9).Value
            End If
           
            If DateValue(Workbooks(V_Quelle).Sheets(1).Cells(i, 7).Value) + 60 > V_Datum And V_Datum >= DateValue(Workbooks(V_Quelle).Sheets(1).Cells(i, 7).Value) + 30 Then
                 Workbooks(V_Ziel).Sheets(1).Cells(g, 7).Value = Workbooks(V_Quelle).Sheets(1).Cells(i, 9).Value
            End If
           
            If DateValue(Workbooks(V_Quelle).Sheets(1).Cells(i, 7).Value) + 90 > V_Datum And V_Datum >= DateValue(Workbooks(V_Quelle).Sheets(1).Cells(i, 7).Value) + 60 Then
                 Workbooks(V_Ziel).Sheets(1).Cells(g, 8).Value = Workbooks(V_Quelle).Sheets(1).Cells(i, 9).Value
            End If
           
            If V_Datum >= DateValue(Workbooks(V_Quelle).Sheets(1).Cells(i, 7).Value) + 90 Then
                 Workbooks(V_Ziel).Sheets(1).Cells(g, 9).Value = Workbooks(V_Quelle).Sheets(1).Cells(i, 9).Value
            End If
           
            g = g + 1
        End If
    Next i
   

   
    Columns("A:H").Select
    ActiveWorkbook.Worksheets("Tabelle1").Sort.SortFields.Clear
    ActiveWorkbook.Worksheets("Tabelle1").Sort.SortFields.Add Key:=Range( _
        "C2:C453"), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:= _
        xlSortNormal
    With ActiveWorkbook.Worksheets("Tabelle1").Sort
        .SetRange Range("A1:I453")
        .Header = xlYes
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
    End With
                                                                                   

                                                                                   
                                                                                   
                                                                                    'Belege zusammenfassen
    For i = 2 To 3000
         If Workbooks(V_Ziel).Sheets(1).Cells(i, 3).Value = Workbooks(V_Ziel).Sheets(1).Cells(i + 1, 3).Value Then
           
            Workbooks(V_Ziel).Sheets(1).Cells(i + 1, 6).Value = Workbooks(V_Ziel).Sheets(1).Cells(i, 6).Value + Workbooks(V_Ziel).Sheets(1).Cells(i + 1, 6).Value
            Workbooks(V_Ziel).Sheets(1).Cells(i + 1, 7).Value = Workbooks(V_Ziel).Sheets(1).Cells(i, 7).Value + Workbooks(V_Ziel).Sheets(1).Cells(i + 1, 7).Value
            Workbooks(V_Ziel).Sheets(1).Cells(i + 1, 8).Value = Workbooks(V_Ziel).Sheets(1).Cells(i, 8).Value + Workbooks(V_Ziel).Sheets(1).Cells(i + 1, 8).Value
            Workbooks(V_Ziel).Sheets(1).Cells(i + 1, 9).Value = Workbooks(V_Ziel).Sheets(1).Cells(i, 9).Value + Workbooks(V_Ziel).Sheets(1).Cells(i + 1, 9).Value
           
            Workbooks(V_Ziel).Sheets(1).Cells(i, 1).EntireRow.Delete Shift:=xlUp
            i = i - 1
         End If
         
         If Workbooks(V_Ziel).Sheets(1).Cells(i + 1, 1).Value = "" Then
            Exit For
         End If
    Next i
   
    Range("A1:I1").Select

    With Selection
        .HorizontalAlignment = xlCenter
        .VerticalAlignment = xlBottom
        .WrapText = False
        .Orientation = 0
        .AddIndent = False
        .IndentLevel = 0
        .ShrinkToFit = False
        .ReadingOrder = xlContext
        .MergeCells = False
    End With
    Columns("A:A").EntireColumn.AutoFit
    Columns("B:B").EntireColumn.AutoFit
    Columns("C:C").EntireColumn.AutoFit
    Columns("D:D").Select
    Selection.Delete Shift:=xlToLeft
    Selection.ColumnWidth = 10.86
    Columns("D:D").EntireColumn.AutoFit
    Columns("E:E").ColumnWidth = 10.86
    Columns("E:E").EntireColumn.AutoFit
    Columns("F:F").EntireColumn.AutoFit
    Columns("G:G").EntireColumn.AutoFit
    Columns("H:H").EntireColumn.AutoFit
    Range("A1:H454").Select
    Selection.Borders(xlDiagonalDown).LineStyle = xlNone
    Selection.Borders(xlDiagonalUp).LineStyle = xlNone
    With Selection.Borders(xlEdgeLeft)
        .LineStyle = xlContinuous
        .ThemeColor = 2
        .TintAndShade = 0.14996795556505
        .Weight = xlThin
    End With
    With Selection.Borders(xlEdgeTop)
        .LineStyle = xlContinuous
        .ThemeColor = 2
        .TintAndShade = 0.14996795556505
        .Weight = xlThin
    End With
    With Selection.Borders(xlEdgeBottom)
        .LineStyle = xlContinuous
        .ThemeColor = 2
        .TintAndShade = 0.14996795556505
        .Weight = xlThin
    End With
    With Selection.Borders(xlEdgeRight)
        .LineStyle = xlContinuous
        .ThemeColor = 2
        .TintAndShade = 0.14996795556505
        .Weight = xlThin
    End With
    With Selection.Borders(xlInsideVertical)
        .LineStyle = xlContinuous
        .ThemeColor = 2
        .TintAndShade = 0.14996795556505
        .Weight = xlThin
    End With
    With Selection.Borders(xlInsideHorizontal)
        .LineStyle = xlContinuous
        .ThemeColor = 2
        .TintAndShade = 0.14996795556505
        .Weight = xlThin
    End With
    Range("A1:H1").Select
    With Selection.Interior
        .Pattern = xlSolid
        .PatternColorIndex = xlAutomatic
        .ThemeColor = xlThemeColorDark1
        .TintAndShade = -0.149998474074526
        .PatternTintAndShade = 0
    End With
    Cells.Select
    With Selection.Font
        .Name = "Calibri"
        .Size = 6
        .Strikethrough = False
        .Superscript = False
        .Subscript = False
        .OutlineFont = False
        .Shadow = False
        .Underline = xlUnderlineStyleNone
        .ThemeColor = xlThemeColorLight1
        .TintAndShade = 0
        .ThemeFont = xlThemeFontMinor
    End With
    Range("C11").Select
   
    Workbooks(V_Ziel).Activate
   
    Cells.Font.Size = 7
    Cells.Font.Name = "Arial"
   
   

   
    Workbooks(V_Ziel).Sheets(1).Columns("A:A").ColumnWidth = 3.3
    Workbooks(V_Ziel).Sheets(1).Columns("b:b").ColumnWidth = 13.57
    Workbooks(V_Ziel).Sheets(1).Columns("c:c").ColumnWidth = 25
    Workbooks(V_Ziel).Sheets(1).Columns("d:d").ColumnWidth = 9.43
    Workbooks(V_Ziel).Sheets(1).Columns("e:e").ColumnWidth = 7.29
    Workbooks(V_Ziel).Sheets(1).Columns("f:f").ColumnWidth = 7.29
    Workbooks(V_Ziel).Sheets(1).Columns("g:g").ColumnWidth = 7.29
    Workbooks(V_Ziel).Sheets(1).Columns("h:h").ColumnWidth = 7.29
   
   
    For i = 2 To 200
   
        Workbooks(V_Ziel).Sheets(1).Cells(i, 4).FormulaR1C1 = "=SUM(RC[1]:RC[4])"
        Workbooks(V_Ziel).Sheets(1).Cells(i, 4).NumberFormat = "#,##0.00 $"
        Workbooks(V_Ziel).Sheets(1).Cells(i, 5).NumberFormat = "#,##0.00 $"
        Workbooks(V_Ziel).Sheets(1).Cells(i, 6).NumberFormat = "#,##0.00 $"
        Workbooks(V_Ziel).Sheets(1).Cells(i, 7).NumberFormat = "#,##0.00 $"
        Workbooks(V_Ziel).Sheets(1).Cells(i, 8).NumberFormat = "#,##0.00 $"

    Next i
   

   
    Columns("A:H").Select
   
    With Selection

        .VerticalAlignment = xlCenter
        .WrapText = True
        .Orientation = 0
        .AddIndent = False
        .IndentLevel = 0
        .ShrinkToFit = False
        .ReadingOrder = xlContext
        .MergeCells = False
    End With
   
   
   
   
End Sub

 
Beste Grüße & einen schönen Abend
leo

[schauan]

Hallöchen,

ich vermute mal, den?

Range("V_Datum").Value = V_Datum

In Deinem Code ehe ich aber nirgends

Range("V_Datum").Value

wenn Du auf den Zellinhalt zugreifen willst.

[Leonhard]

Hi,

wenn ich dich richtig verstehe vermisst du meinen Versuch deinen Tipp im Code umgesetzt zu haben?

Versucht habe ich es, aber wie gesagt.. wahrscheinlich wieder zu tölpelhaft umgesetzt.

Beste Grüße
Leo

[schauan]

Hallöchen,

1)
wenn Du z.B. Daten mit dem Zellinhalt vergleichen willst, müsstest Du z.B. statt

If V_Datum …

If Range("V_Datum").Value …

nehmen


2)
Andererseits, Du hast oben

Sub Auto_open()
...
    Dim VDatum As Date


Mal abgesehen davon, dass Du VDatum nirgends verwendest und V_Datum nicht dimensioniert hast, passt da was nicht.
Wenn, dann eventuell so:

Sub Auto_open()
...
    Dim V_Datum As Date
    V_Datum = Range("V_Datum").Value


Wenn Du oben in Deinem Modul
Option Explicit

schreibst, würdest Du auch Meldungen bekommen, zumindest, dass V_Datum nicht deklariert ist. Da wäre Dir der Unterschied sicher selbst aufgefallen.


Ach so, und bitte nur eine Variante nehmen 1 oder 2

[Kuwer]

Hi Andre,

ich glaube, Leo geht es nur um den Ersatz des DTPickers, siehe #3, da er wohl nicht mehr geht.

Gruß Uwe

[Leonhard]

Hallo zusammen,

genau wie Uwe sagt. Kann durchaus sein das da im aktuellen Code noch gewisse Redundanzen sind die man nicht braucht

Beste Grüße
leo