Question

我将数据复制到工作表中，而不是存储为变体。我需要将数据偏移2列（向右），并能够将第一列中的日期和作为字符串存储的预定义数字添加到下一列中。

虽然我可以抵消主要数据块，但我无法弄清楚如何将所需信息添加到所有偏移单元中。我设法将它复制到数据的第一行，如果有帮助，我将v的行数存储为值（RowCounter）。只是为了添加背景信息，这是一个累积工作表，因此将不断添加数据。

代码的当前部分：

  With SupSheet
      .Cells(.Rows.Count, "A").End(xlUp).Offset(1).Value = Date
      .Cells(.Rows.Count, "A").End(xlUp).Offset(, 1).Value = SupCount
      .Cells(.Rows.Count, "A").End(xlUp).Offset(, 2).Resize(UBound(v, 1), UBound(v, 2)).Value = v
  End With

Answer 1

我设法在特定列中获取所需的单元格，以填充一个简单的小循环，在LastRow + 1和LastRow + RowCounter之间添加数据。以下是我的整个代码。该主题涉及的部分介于'Copy to relevant matching sheet到'Remove copied rows

之间

Option Explicit

Public Sub CreateRETfile()
   Dim rawDataSheet, SupSheet As Worksheet
   Dim newBook As Workbook
   Dim v As Variant
   Dim cc As Variant
   Dim supID, SupCount, NamePrefix As String
   Dim footerCount, Rowcounter, i, j, k As Integer
   Dim lastrow As Long

'Store Supplier ID
Set rawDataSheet = ThisWorkbook.Worksheets("Raw Data")
supID = Trim(rawDataSheet.Range("A2").Value)

'Check for records
If IsEmpty(rawDataSheet.Cells(2, 2)) Then
MsgBox ("Error!" & vbNewLine & _
"No records found to create RET file." _
& vbNewLine & "Please add at least 1 record.")
Exit Sub
End If

 'Check for SupID as sheet and if it doesn't exist create it
On Error Resume Next
Set SupSheet = ThisWorkbook.Worksheets(supID)
lastrow = SupSheet.Cells(SupSheet.Rows.Count, "A").End(xlUp).Row + 1
On Error GoTo 0
If SupSheet Is Nothing Then
    With ThisWorkbook.Worksheets
        Set SupSheet = .Add(After:=.Item(.Count))
    End With
    SupSheet.Name = supID
    With ThisWorkbook.Worksheets(supID)
        .Range("A1").Resize(, 17) = Array( _
        "RET", "Init Supplier", "Init Agent", "Unique ID", "MPRN", _
        "House Name/Number", "Street", "Postcode", "Cust Name", "Cust Tele", _
        "No Contact", "CoS Date", "CC Date", "Reason", "Status", "Asso Supplier", "Asso Agent")
        .Range("BA1").NumberFormat = "00000"
        .Range("BA1").Value2 = "10000"
    End With
End If

ThisWorkbook.Worksheets(supID).Range("BA1").Value = ThisWorkbook.Worksheets(supID).Range("BA1").Value + 1
SupCount = Trim(ThisWorkbook.Worksheets(supID).Range("BA1").Text)
NamePrefix = "CTO" & supID & SupCount

'Count Rows to be Copied
cc = rawDataSheet.Range("A2:A10").Value
For j = 1 To UBound(cc, 1)
    If cc(j, 1) = Range("A2") Then Rowcounter = Rowcounter + 1
Next

'Create workbook
Set newBook = Workbooks.Add

'Copy Records
v = rawDataSheet.Range("B2:X" & Rowcounter + 1).Value
For i = 1 To UBound(v, 1)
    If v(i, 1) = "RET" Then footerCount = footerCount + 1
Next

'Write new sheet
With newBook.Worksheets(1)
    'Values
    .Range("A2").Resize(UBound(v, 1), UBound(v, 2)).Value = v
    'Header
    .Range("A1").Resize(, 13) = Array( _
        "ZHF", "CTO", "RET", supID, "RET", "RET", "6", "PROD", _
        NamePrefix & "RET.CSV", NamePrefix, _
        Format(Date, "ddmmyyyy"), "Unknown", "1")
    'Footer
    .Cells(.Rows.Count, "A").End(xlUp).Offset(1).Resize(, 3).Value = Array( _
        "ZFV", "BATCH" & SupCount, footerCount)
    'Name
    .Name = NamePrefix & "RET"

    'Save
    .SaveAs ThisWorkbook.Path & "\" & NamePrefix & "RET.CSV"
End With
newBook.Close savechanges:=False

'Copy to relevant matching sheet
With SupSheet
    .Cells(.Rows.Count, "A").End(xlUp).Offset(1, 2).Resize(UBound(v, 1), UBound(v, 2)).Value = v
End With

'Fill in date and ID column
For k = lastrow To lastrow + Rowcounter
    If SupSheet.Cells(k, 3).Value = "RET" Then SupSheet.Cells(k, 1).Value = Date
    If SupSheet.Cells(k, 3).Value = "RET" Then SupSheet.Cells(k, 2).Value = SupCount
Next

'Remove copied rows
rawDataSheet.Range("B2:X" & Rowcounter + 1).EntireRow.Delete

End Sub

尝试偏移列并将数据添加到预定义的列数中

1 个答案: