Question

我有一个主数据集，上面已经有一些数据。我正在尝试通过匹配列名来将另一个Excel工作表中的其他数据附加到此主数据集中，并将对应的数据粘贴到我无法执行的主文件中。

我的主数据集的数据顺序与我需要附加的新数据的顺序不同。因此，我的代码在目标（主数据集）和源（Excel中的新数据）中寻找匹配的标题，并尝试在匹配的列下复制和粘贴相应的值。


Sub AppendData()

' AppendData Macro

Application.ScreenUpdating = False

' create worksheet objects
Dim shtSource As Worksheet
Dim shtTarget As Worksheet
Dim strFile As String

Set shtTarget = ActiveWorkbook.Sheets("MASTER - Formatted")
strFile = ActiveWorkbook.Worksheets("Macro").Range("C2").Value
If CStr(strFile) <> "False" Then

        Set shtSource = Workbooks.Open(strFile).Sheets(1)

        ' create range objects
        Dim rngSourceHeaders As Range: Set rngSourceHeaders = shtSource.Range("B1:S1")

        shtTarget.Activate
        With shtTarget
            Dim rngTargetHeaders As Range: Set rngTargetHeaders = .Range("K1:AA1") '.Cells(1, 1), .Cells(1, .Columns.Count).End(xlToLeft))
            Dim rngPastePoint As Range: Set rngPastePoint = .Cells(.Rows.Count, 1).End(xlUp).Offset(1) 'Shoots up from the bottom of the sheet untill it bumps into something and steps one down
        End With

Dim rngDataColumn As Range

        ' process data
        Dim cl As Range, i As Integer
        For Each cl In rngTargetHeaders ' loop through each cell in target header row


            ' identify source location
            shtSource.Activate
            i = 0 ' reset I
            On Error Resume Next ' ignore errors, these are where the value can't be found and will be tested later
                i = Application.Match(cl.Value, rngSourceHeaders, 0) 'Finds the matching column name
            On Error GoTo 0 ' switch error handling back off

            ' report if source location not found
            If i = 0 Then
                intErrCount = intErrCount + 1
                Debug.Print "unable to locate item [" & cl.Value & "] at " & cl.Address ' this reports to Immediate Window (Ctrl + G to view)
                GoTo nextCL
            End If

        ' create source data range object
            With rngSourceHeaders.Cells(1, i)
                Set rngDataColumn = Range(.Cells(2, 1), .Cells(1000000, 1).End(xlUp))
            End With

            ' pass to target range object
            shtTarget.Activate
            cl.Offset(1, 0).Resize(rngDataColumn.Rows.Count, rngDataColumn.Columns.Count).Value = rngDataColumn.Value

nextCL:
        Next cl

        Application.CutCopyMode = False

        shtSource.Activate
        ActiveWorkbook.Close False


        Else

        Application.ScreenUpdating = True

        MsgBox "No valid file selected", vbOKOnly + vbInformation, "Copy Error"


End If

End Sub

当前，如果我的母版表仅包含标头且上面没有现有数据，则我的代码可以正常工作。如果我运行此代码，它将所有新数据粘贴到第2行（第1行是标题）的匹配列下。

但它不会追加到我想要的输出的最后一个现有行上。

我在主数据集中当前大约有20000行，例如，我需要从行20001追加新数据。

将感谢您提供有关此代码的帮助。

谢谢！

Answer 1

我认为这行：

import decimal

decimal.getcontext().prec = 4
significand, base = str(11.0000123456789).split('.')
fp = significand + str(decimal.Decimal('.' + base) + 0)[1:]  # I need to add 0 here for it to work
print(fp)

需要使用最后使用的行，当前它从标题行偏移1。

无法将数据追加到现有数据

1 个答案: