Question

我正在使用两个文件，我们将其命名为File 1，File 2我的脚本每次追加File 1时都会将数据从File 2附加到File 2我想从我的专栏中插入Current Date。

文件1：

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

文件2

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

示例输出：

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 |

正如您所看到的，上面的示例输出在“标题3”中插入了当前日期。

我的问题是，如果我追加来自File 2的数据，那么它最密切地返回Header 3中的当前日期，但如果我再次附加它，则更新最后一个。为了说清楚，让我们举另一个例子。

Sample Out :(这是我脚本的输出）

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

如果我再次追加来自File 1的数据，那么这就是输出

 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        |         |

我想在每次添加新数据时插入当前日期，我的代码将日期插入后面一步，我与我的代码@ @联系了gagin。@请帮助我！

我的代码：

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

复制文件后必须添加数据，如下所示：

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

我还没有对它进行测试，但第二个循环的想法是仅在单元格为空时才添加数据。你可以优化它。

Answer 2

这是一种更快捷的方式

<强>逻辑：

读取内存中的文本文件并将其存储在数组中
在第3栏中插入日期

<强>代码

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

VBA - 在列中插入当前日期

2 个答案: