Question

我在某些方面感到震惊，我不知道如何继续循环，所以这里是我做的事情

我有一张excel工作簿，其中包含不同的工作表（Mcq Results），Sheet（Data_Neu）和Sheet（章节）。我尝试使用代码从章节表到MCQ结果表中的章节，但我希望这是一个连续的过程，直到所有用户（Operator_Name）在MCQ结果中完成

A2到A13是章节编号.B2到B13是章节名称。 C2至C13是项目编号。

我希望所有这些代码都能正常运行，直到Mcq Results（Operator_name）为空

附上你会找到代码。

谢谢。

<aui:input type="checkbox" id="expenseCheckbox" name="expenseCheckbox"
    label="" value="${status == 'Business Unit Approal'}"
    data-amount="${expData.expenseAmount}" data-expenseid="${expData.expenseId}"
    cssClass="custom-control-input expense select-all" />

Answer 1

我不确定我是否正确理解你想要做什么，但我会试试这个：

Sub Chapters_Mcq()

    Dim Sht3 As Worksheet
    Dim Sht2 As Worksheet
    Dim i, last, lr1, lr2, lr3 As Long
    Set Sht3 = Worksheets("Chapters")
    Set Sht2 = Worksheets("Mcq Results")

    t = 2

    last = Sht3.Range("A1").End(xlDown).Row

    Do Until t > last

    lr1 = Sht2.Range("G1").End(xlDown).Row
    Sht3.Range("A" & t & ":A" & t + 11).Copy
    Sht2.Cells(lr1+1, 7).PasteSpecial Paste:=xlPasteValues

    lr2 = Sht2.Range("H1").End(xlDown).Row
    Sht3.Range("B" & t & ":B" & t + 11).Copy
    Sht2.Cells(lr2+1, 8).PasteSpecial Paste:=xlPasteValues

    lr3 = Sht2.Range("M1").End(xlDown).Row
    Sht3.Range("C" & t & ":C" & t + 11).Copy
    Sht2.Cells(lr3+1, 13).PasteSpecial Paste:=xlPasteValues

    t = t + 12

    Loop

End Sub

Answer 2

'Sub Chapters_Mcq()
Application.ScreenUpdating = False
Dim Sht3 As Worksheet
Dim Sht2 As Worksheet
Dim i, j  As Integer
Dim LastBlankRow As Long
Dim rng As Range
Dim cell As Range


Set Sht3 = Worksheets("Chapters")
Set Sht2 = Worksheets("Mcq Results")

 'LastRow = Sht2.Range("A" & Sht2.Rows.Count).End(xlUp).Offset(0).Row
 'LastRow2 = Sht2.Range("G" & Sht2.Rows.Count).End(xlUp).Offset(0).Row
 'NumRows = Sht2.Range("A1", Range("A1").End(xlUp)).Rows.Count
 'Sht2.Activate


'LastBlankRow = Cells(Rows.Count, 1).End(xlUp).Row + 1
 LastRow = Sht2.Range("A" & Sht2.Rows.Count).End(xlUp).Offset(0).Row

 For i = 1 To LastRow

LastRow = Sht2.Range("A" & Sht2.Rows.Count).End(xlUp).Offset(0).Row
LastRow2 = Sht2.Range("A" & Sht2.Rows.Count).End(xlUp).Offset(0, 6).Value

If (LastRow2 = "") Then


'If IsEmpty(LastRow) = True Then

'Range("A1").Select


'Sht2.Cells(Rows.Count, 7).End(xlUp).Offset(1, 0).Value = Sht3.Range("A2:A13").Value
'Sht2.Cells(Rows.Count, 8).End(xlUp).Offset(1, 0).Value = Sht3.Range("B2:B13").Value
'Sht2.Cells(Rows.Count, 13).End(xlUp).Offset(1, 0).Value = Sht3.Range("C2:C13").Value
Sht3.Range("A2:A13").Copy

  Sht2.Cells(Rows.Count, 7).End(xlUp).Offset(1, 0).PasteSpecial xlPasteValues
Application.CutCopyMode = False
'Application.ScreenUpdating = True
Sht3.Range("B2:B13").Copy
Sht2.Cells(Rows.Count, 8).End(xlUp).Offset(1, 0).PasteSpecial xlPasteValues
Application.CutCopyMode = False
'Application.ScreenUpdating = True
Sht3.Range("C2:C13").Copy
Sht2.Cells(Rows.Count, 13).End(xlUp).Offset(1, 0).PasteSpecial xlPasteValues
Application.CutCopyMode = False

End If
Next i
LastRow = Sht2.Range("A" & Sht2.Rows.Count).End(xlUp).Offset(0).Row
LastRow2 = Sht2.Range("A" & Sht2.Rows.Count).End(xlUp).Offset(0, 6).Row

If (LastRow = LastRow2) Then

Exit Sub

End If

End Sub'

Excel VBA列将粘贴复制到下一个12列

2 个答案: