Question

我不确定如何使用VBA，并希望在excel上使用VBA寻求帮助。

宏的目标是复制一列数据＆＃34; B＆＃34;从工作表（即＆＃34;选择的问题＆＃34;）并将其粘贴到固定列＆＃34; A＆＃34;在另一个工作表中（即＆＃34;试卷＆＃34;）。
然后将粘贴的值与另一个工作表（即＆＃34;第1章＆＃34;）匹配，如果＆＃34;测试纸中的单元格＆＃34;包含一个与列中的另一个单元格相匹配的值＆＃34; A＆＃34; ＆＃34;第1章＆＃34;那么它将复制来自＆＃34;第1章＆＃34;进入＆＃34;试卷＆＃34;
并且宏从第34页的第1步开始重复自己;＆＃34; C＆＃34;向前，粘贴列＃34; A＆＃34;中的下一个可用空白单元格中的值。＆＃34;试卷＆＃34;

我目前的代码如下：

Sub Test()

＆＃39;

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

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

1 个答案: