根据单元格值从另一个工作表复制数据

Question

我不确定如何使用 VBA，并希望就我在 Excel 上使用 VBA 实现的目标寻求帮助。

• 宏的目标是从工作表中复制一列数据“B”（即“选定的问题”）并将其粘贴到另一个工作表的固定列“A”中（即“试卷” )。

• 然后，粘贴的值将匹配到另一个工作表（即“第 1 章”），如果“试卷”中的单元格包含与“第 1 章”的“A”列中的另一个单元格匹配的值，则它会将“第 1 章”中的特定数据行复制到“试卷”中

• 为了让宏从“C”列的第一步开始重复，将值粘贴到“试卷”的“A”列中下一个可用空白单元格中

我目前的代码如下：

Sub Test()

'

Set Source = Sheets("Questions Selected")
Worksheets.Add(After:=Worksheets("Main Page")).Name = "Test Paper" 'Adds a Sheet called "Test Paper"
Dim rng As Range
Set Destination = Sheets("Test Paper")
Source.Select
Set rng = Range("B2:B" & Source.Cells(Source.Rows.Count, "B").End(xlUp).Row)
With rng
    .Copy
Destination.Columns(1).PasteSpecial xlPasteValues
End With
End Sub

我不明白如何继续我的 VBA，目前的编码只能让我迈出第一步。

感谢我能得到的所有帮助。

Answer 1

试试这个方法。它应该可以为您提供所需的东西。未测试：
这些循环和检查单个单元格的概念可以应用于许多不同的情况。策略性地将循环放置在其他循环中，使用行号和列号作为计数器并利用 .Cells(row,col) 格式。

Private Sub TableCheck()

Dim lastQsRow           'Last Row on Questions Selected
Dim lastQCol As Long    'Last Column on Questions Selected
Dim qColNum As Long     'Questions Selected Column Number

Dim lastTestRow As Long 'Last Test Paper Row
Dim tempRow As Long     'tempRow to keep track of place on Test Paper between loops
Dim testRow As Long     'Editing row on Test paper

Dim chapNum As Long     'Chapter Number for the Sheet Name
Dim lastChCol As Long   'Last Chapter Column
Dim lastChRow As Long   'Last Chapter Row
Dim chRow As Long       'Chaper Row
Dim chColNum As Long    'Chapter Column Number for copying entire row Loop.

'Set the Last Column on "Questions Selected"
lastQCol = Sheets("Questions Selected").Cells(1, Columns.Count).End(xlToLeft).Column
testRow = 2  'Set Row of "Test Paper" to 2 or whatever your first Non-Header Row is.

'-----PHASE ONE - COPY COLUMNS FROM "QUESTIONS SELECTED" TO "TEST PAPER" ----- BIG LOOP
For qColNum = 2 To lastQCol  'Begin Column Loop at column 2("B")
    tempRow = testRow
    lastQsRow = Sheets("Questions Selected").Cells(Rows.Count, qColNum).End(xlUp).Row
    'Get the Last Row of Column
    For qsRow = 2 To lastQsRow 'Loop from first NON-Header Row to the Last Row) on "Questions Selected"
        Sheets("Test Paper").Cells(testRow, "A").Value = Sheets("Questions Selected").Cells(qsRow, qColNum).Value
        testRow = testRow + 1
    Next qsRow

    '----PHASE TWO - COMPARE EACH ROW OF "TEST PAPER" TO "CHAPTERs" AND COPY MATCHING ROWS ---- INNER LOOP
    chapNum = 1
    'Get Last Row of "Chapter" & "Test Paper"
    lastChRow = Sheets("Chapter " & chapNum).Cells(Rows.Count, "A").End(xlUp).Row
    lastTestRow = Sheets("Test Paper").Cells(Rows.Count, "A").End(xlUp).Row

    'Loop through "Test Paper"
    For testRow = tempRow To lastTestRow
        'Loop through "Chapter"
        For chRow = 2 To lastChRow
            'Compare Value of Current Row on "Test Paper" to "Chapter"
            If Sheets("Test Paper").Cells(testRow, "A").Value = Sheets("Chapter " & chapNum).Cells(chRow, "A").Value Then
                lastChCol = Sheets("Chapter " & chapNum).Cells(chRow, Columns.Count).End(xlToLeft).Column
                'If Matching, copy every column from "Chapter" to "Test Paper"
                For chColNum = 2 To lastChCol
                    Sheets("Test Paper").Cells(testRow, chColNum).Value = Sheets("Chapter " & chapNum).Cells(chRow, chColNum).Value
                Next chColNum
            End If
        Next chRow
    Next testRow

    chapNum = chapNum + 1

Next qColNum

End Sub