VBA - Legen Sie das aktuelle Datum in Spalte

Question

Ich bin mit zwei Dateien wir nennen es File 1 und File 2 mein Skript fügen Sie die Daten File 1-File 2 jetzt jedes Mal, wenn ich anhängen File 2 i Current Date aus meiner Spalte eingefügt werden soll.

Datei 1:

Header 1 | Header 2 | Header 3| 
1  | 1  |   | 
1  | 1  |   | 

Datei 2

Header 1 | Header 2 | Header 3| 
    a  | a  | 3/3/2016| 
    a  | a  | 3/3/2016| 

Beispielausgabe:

Header 1 | Header 2 | Header 3| 
    a | a  |3/3/2016 | 
    a | a  |3/3/2016 | 
    1 | 1  |4/4/2016 | 
    1 | 1  |4/4/2016 | 

Wie Sie die Probe sehen aus setzen oben eingefügt das aktuelle Datum in `Header 3.

Mein Problem ist, dass, wenn ich die Daten von File 2 anfügen es dichteste das aktuelle Datum in Header 3 zurück, aber wenn ich es wieder anhängen aktualisiert es die letzte. um es klar zu machen, lassen Sie uns ein anderes Beispiel geben.

Probe aus: (Dies ist die Ausgabe von meinem Skript)

Header 1 | Header 2 | Header 3| 
    a | a  |3/3/2016 | 
    a | a  |3/3/2016 | 
    1 | 1  |   | 
    1 | 1  |   | 

Wenn ich die Daten von File 1 anhängen wieder diese

Header 1 | Header 2 | Header 3| 
    a | a  |3/3/2016 | 
    a | a  |3/3/2016 | 
    1 | 1  |4/4/2016 | 
    1 | 1  |4/4/2016 |  
    1 | 1  |   | 
    1 | 1  |   | 

ich einfügen möchten das aktuelle Datum nun der Ausgang jedes mal, wenn ich eine neue daten anlege, meinen code füge das datum einen schritt hinter und ich bin connfused gagin mit meinem code @. @ Bitte Helfen Sie mir!

Mein Code:

Public Sub addweeklydata() 

Dim file1 As Excel.Workbook 
Dim file2 As Excel.Workbook 
Dim Sheet1 As Worksheet 
Dim Sheet2 As Worksheet 

Dim Rng As Range 

    Set Sheet1 = Workbooks.Open(TextBox1.Text).Sheets(1) 
    Set Sheet2 = Workbooks.Open(TextBox2.Text).Sheets(1) 

    lastRow = Sheet2.Range("A" & Rows.Count).End(xlUp).Row 

    For i = 2 To lastRow 
     Sheet2.Cells(i, 4).Value = Date 

    Set Rng = Sheet1.Range("A1").CurrentRegion 'assuming no blank rows/column 
    Set Rng = Rng.Offset(1, 0).Resize(Rng.Rows.Count - 1, Rng.Columns.Count) 'exclude header 
Next 
    Sheet2.Cells(Rows.Count, 1).End(xlUp).Offset(1, 0).Resize(_ 
       Rng.Rows.Count, Rng.Columns.Count).Value = Rng.Value 

Sheet2.Parent.Close True 'save changes 
Sheet1.Parent.Close False 'don't save 

End Sub 

Answer 1

Sie haben die Daten hinzuzufügen, nachdem Sie die Dateien, so etwas wie diese zu kopieren:

Public Sub addweeklydata() 

Dim file1 As Excel.Workbook 
Dim file2 As Excel.Workbook 
Dim Sheet1 As Worksheet 
Dim Sheet2 As Worksheet 

Dim Rng As Range 

    Set Sheet1 = Workbooks.Open(TextBox1.Text).Sheets(1) 
    Set Sheet2 = Workbooks.Open(TextBox2.Text).Sheets(1) 

    lastRow = Sheet2.Range("A" & Rows.Count).End(xlUp).Row 

    For i = 2 To lastRow 
     Sheet2.Cells(i, 4).Value = Date 

     Set Rng = Sheet1.Range("A1").CurrentRegion 
     Set Rng = Rng.Offset(1, 0).Resize(Rng.Rows.Count - 1, Rng.Columns.Count) 
    Next 

    Sheet2.Cells(Rows.Count, 1).End(xlUp).Offset(1, 0).Resize(_ 
       Rng.Rows.Count, Rng.Columns.Count).Value = Rng.Value 

    lastRow = Sheet2.Range("A" & Rows.Count).End(xlUp).Row 
    For i = 2 To lastRow 
      if not cbool(len(Sheet2.Cells(i, 4))) then Sheet2.Cells(i, 4) = Date 
    next i 

    Sheet2.Parent.Close True 'save changes 
    Sheet1.Parent.Close False 'don't save 

End Sub 

ich es nicht getestet haben, aber die Idee, die Die zweite Schleife besteht darin, Daten nur hinzuzufügen, wenn die Zelle leer ist. Sie können es optimieren.

Answer 2

Hier ist ein schneller Weg, es zu tun

Logic:

1. die Textdatei im Speicher lesen und speichert sie in einem Array
2. das Datum einfügen in der 3. Spalte

Code

Sub Sample() 
    Dim MyData As String, strData() As String 
    Dim TempAr 

    '~~> Read the text file in memory in one go 
    Open "C:\File1.Txt" For Binary As #1 
    MyData = Space$(LOF(1)) 
    Get #1, , MyData 
    Close #1 
    strData() = Split(MyData, vbCrLf) 

    For i = LBound(strData) To UBound(strData) 
     TempAr = Split(strData(i), "|") 
     If Len(Trim(TempAr(2))) = 0 Then TempAr(2) = Date 
     strData(i) = Join(TempAr, "|") 

     Debug.Print strData(i) 
    Next i 

    '~~> strData now has all the data from file1 with date in it 
    '~~> Simply append the array to the 2nd text file 
End Sub