Question

由于我在其他主题中找不到我的问题的解决方案，我会尝试尽可能具体。

问题是：我需要将信息复制为：日期和时间，代码和名称来自大数据表，其中包含多个列，但这些行数可能不同。

行动的顺序应该是：

将连续范围从 A3 （第一个活动单元格）复制到AZ列 - 这是手动选择。
使用VBA链接的命令按钮启动下一页中复制数据的过程：例如

sheet1.column B  = sheet2.column A
sheet2.column B= "" 
'empty and data copy is not needed, please just generate the empty row
sheet1.column Y = sheet2.column C

复制过程结束后，请清除sheet1中的所有数据

我的核心问题是上述行的数据计数每次都不同。我似乎找不到正确的命令序列来按照我需要的顺序从sheet1获取这些列。除此之外，格式化中断和时间值是“字符串化”，因此无法重复使用。

生成的数据需要导出到另一个工作簿，复制过程非常重要，因为我反复这样做。每次手动定位和复制每一列都是一段时间浪费。

我希望有人可以帮我解决这个问题。

祝你好运， Marcis

Answer 1

问题的解决方案是 f（x）= y ，其中 x 是列号。源表单和 y 是目标工作表上同一列的列号。 f（x）是Source列之间的简单映射，并转换为目标列号

由于您仍需要通过包含示例数据来更好地定义问题，因此我只简要介绍解决问题的3个步骤。我希望您能够充分了解您的VBA，将步骤编码为您需要永久解决的特定VBA代码。

将表格创建为＆＃34; ControlPanel＆＃34;映射您需要的列。
假设您的工作表根据以下代码正确命名。

请根据您的需要，运用您的VBA技能和自由裁量权来自定义以下代码。

Public Sub Add_Msng_And_Check_Prev_EmpData()
''  Objective : Check missing employees from the incoming data placed in the Destination_Sheet sheet which is the client's format.
''  The _Source_Sheet sheet is our destination where processed data sits,
''  columns from Destination_Sheet are mapped to specific columns of the _Source_Sheet sheet.
''  Copy the missing emp codes to these mapped columns.

'' Support :  myfullnamewithoutspaces@gmail.com
'' Status : Production 14-Dec-2016 10.32 PM
'' Version : 1.0
'' To Do : 10 is the column number on Source_Sheet where the emp code resides
'' Convert this magic number to a generic solution

Dim Src_Sheet, Destination_Sheet As Worksheet
Dim Dest_Sheet_Column_Mapping, Src_Sheet_Column_Location As Range

Set Src_Sheet = Sheets("Source_Sheet")
Set Destination_Sheet = Sheets("Destination_Sheet")

Set Dest_Sheet_Column_Mapping = Sheets("ControlPanel").Range("A2:A60")
Set Src_Sheet_Column_Location = Sheets("ControlPanel").Range("D2:D60")

Dim myMap()  As Integer
Dim myRow As Variant
ReDim myMap(Dest_Sheet_Column_Mapping.Count + 1)

'' Map the source_columns to the destination_columns
For Each myRow In Src_Sheet_Column_Location
'' Index corresponds to Source_Sheet column
'' Value at Index to Destination_Sheet
'' for eg: Destination_Sheet.column = myMap(Src_Sheet.column)
    myMap(myRow) = Dest_Sheet_Column_Mapping.Cells(myRow, 1).Value
Next myRow

Dim Primary_Key_Not_Null As Collection
Set Primary_Key_Not_Null = New Collection
Dim Master, Src_Sheet_Range, Src_Range As Range
Dim MissingEmployeeCode, LookupValue, tempVar, LookupResult  As Variant
Dim LastRow, i, Src_Range_Rows_Count, Src_Sheet_Range_Rows_Count As Integer

'' This is the source of all new entries we need to search for.
Set Src_Sheet_Range = Destination_Sheet.Range(Destination_Sheet.Cells(1, myMap(10)), Destination_Sheet.Cells(Destination_Sheet.Cells(1048576, myMap(10)).End(xlUp).Row, myMap(10)))
Src_Sheet_Range_Rows_Count = Src_Sheet_Range.Rows.Count

'' This is the database of all previous existing entries we need to search against.
Set Src_Range = Src_Sheet.Range(Src_Sheet.Cells(1, 10), Src_Sheet.Cells(Src_Sheet.Cells(1048576, 10).End(xlUp).Row, 10))
Src_Range_Rows_Count = Src_Range.Rows.Count

    For i = 3 To Src_Sheet_Range_Rows_Count
    '' Skip the blank rows and header at rows 0 to 2
        On Error Resume Next
        LookupValue = Destination_Sheet.Cells(i, myMap(10)).Value
            LookupResult = Application.Match(LookupValue, Src_Range, 0)
                If (IsError(LookupResult)) Then
                '' To Do : Check for Duplicates within the previously added values
                '' LookupValue becomes your missing empcode and i is the row number it's located at
                '' The row number i becomes critical when you want to copy the same record that you have just found missing.
                    Primary_Key_Not_Null.Add i '' LookupValue
                    '' LookupValue is the actual missing empcode, however we need the row number for the copy operation later
                End If
    Next i

LastRow = Src_Sheet.Cells(1048576, 10).End(xlUp).Offset(1, 0).Row
Dim FirstRow, LastColumn, j, Src_Range_Columns_Count As Integer
FirstRow = LastRow

''--Phase 3--------------------------------------------------------------------------------------------------
'' Objective : Get and paste data for each missing empcode
With Src_Range
    LastColumn = .Cells(1, 1).End(xlToRight).Column
    LastRow = Primary_Key_Not_Null.Count + FirstRow
    Set Src_Range = .Range(.Cells(1, 1), .Cells(LastRow, LastColumn))
    Src_Range_Columns_Count = Src_Range.Columns.Count
        For i = FirstRow To LastRow ''FirstRow + 3 '' Commented for Debugging
            For j = 1 To Src_Range_Columns_Count '' 59
            ''  The simple logic is Row Numbers and Column numbers obtained from all the above operations
            ''  define the cells in the Src_Sheet sheet that we need this data pasted ito.
            ''  For details please see the code below.
            Src_Sheet.Cells(i, j).Value = Destination_Sheet.Cells(Primary_Key_Not_Null(i - FirstRow + 1), myMap(j)).Value
            Next j
        Next i
End With

''--Phase 4--------------------------------------------------------------------------------------------------
''  Objective : For the previous range in Source_Sheet, check each cell in each column against the mapped columns in the Destination_Sheet.
''  When you find a discrepancy: style it Bad, for the matches: style it Good,
''  for the not found : Style it neutral.
LastRow = FirstRow
FirstRow = 2
Set Src_Range = Src_Sheet.Range(Src_Sheet.Cells(2, 1), Src_Sheet.Cells(LastRow, LastColumn))
Src_Range.Style = "Normal"

Dim FoundRow, FoundColumn As Integer
FoundRow = 0
FoundColumn = 10
Dim LookupRange, LookupDatabase As Range
Set LookupRange = Src_Sheet.Range(Src_Sheet.Cells(1, 10), Src_Sheet.Cells(LastRow, 10))
Set LookupDatabase = Destination_Sheet.Range(Destination_Sheet.Cells(1, myMap(10)), Destination_Sheet.Cells(Src_Sheet_Range_Rows_Count, myMap(10)))

Dim FoundRows As Collection
Set FoundRows = New Collection

'' Locate the row of each employee code on Emp Master, push it into a collection and let the emp code be it's key
Dim LookupRange_Row_Count As Integer
LookupRange_Row_Count = LookupRange.Rows.Count
For i = 2 To LookupRange_Row_Count
On Error Resume Next
    FoundRow = Application.Match(LookupRange.Cells(i, 1).Value, LookupDatabase, 0)
    If (Not IsError(FoundRow)) Then
    '' myRow contains EmpCode which is the key, FoundRow = Where I Found it, becomes the value.
     FoundRows.Add FoundRow, CStr(LookupRange.Cells(i, 1).Value)
    End If
Next i

Dim Src_Sheet_Value, EmpMstrValue, myEmpCodeString As String

For i = FirstRow To LastRow '' 2 to 1029
    For j = 1 To Src_Range_Columns_Count '' 59
    ''  Handle 4 cases.
    ''  1.  Src_Sheet Cell Value Found and matches = Good
    ''  2.  Src_Sheet Cell Value Found and does not match = Bad
    ''  3.  Src_Sheet Cell Value Not Found or not in Scope and hence does not match = Neutral
    ''  4.  Src_Sheet Cell Value is a duplicate of a value which is already checked earlier. = ??
    Src_Sheet_Value = Src_Sheet.Cells(i, j).Value
        myEmpCodeString = CStr(LookupRange.Cells(i, 1).Value)
        myRow = CInt(FoundRows(myEmpCodeString))
    EmpMstrValue = Destination_Sheet.Cells(myRow, myMap(j)).Value

    ''  Implements 1.  Src_Sheet Cell Value Found and matches = Good

    If Src_Sheet_Value = EmpMstrValue Then
        Src_Sheet.Cells(i, j).Style = "Good"
    Else
        Src_Sheet.Cells(i, j).Style = "Bad"
    End If

    Next j
Next i
End Sub

我发现自己的状况与你自己的情况相同。尽管代码在概念上很简单，但它要求您在源，目标，转换模式中彻底定义问题。请随意发邮件至myfullnamewithoutspaces@gmail.com。我会以任何方式提供帮助。

如何从特定顺序将特定列从一个工作表复制到另一个工作表？

1 个答案: