Question

图片1：This image is for machine number if the machine number In practical results sheet matches the data in machine number in chapter sheet the data has to be copied in the sheet practical results 图2：Machine number in Practical sheet [如果机器编号匹配，应在此处粘贴最高分] 图3：3我有一个与Excel VBA相关的小问题。

我在工作簿中有3张纸：

sheet1：章节
sheet2：Mcq结果和
表3：实际结果

我的问题是如何在Excel VBA中使用if … else语句，以便我想检查Sheet1中的机器编号列，如果sheet1.Machinenumber = Sheet2.Machinenumber必须填写，请再次交叉检查sheet2中的机器编号从sheet1到sheet2最高得分列的所有12行。

任何想法都会受到赞赏。

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("Practical results")

If (Sht2.Range(E1)) = "M03" Then
Sht3.Range("I2:I13").Copy
Sht2.Cells(Rows.Count, 9).End(xlUp).Offset(1, 0).PasteSpecial xlPasteValues
ElseIf (Sht2.Range(E1)) = "M04" Then
Sht3.Range("J2:J13").Copy
Sht2.Cells(Rows.Count, 9).End(xlUp).Offset(1, 0).PasteSpecial xlPasteValues
End If

第二段代码：

Sub Copypaste_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
Dim machineNum As String

LastRow = Sht2.Range("E" & Sht2.Rows.Count).End(xlUp).Offset(0).Row
Lastrow2 = Sht2.Range("E" & Sht2.Rows.Count).End(xlUp).Offset(0, 4).Value
machineNum = Sht3.Cells(E1).Value

If (machineNum = Sht2.Cells(I1)) Then
Sht3.Range("I2:I13").Copy
Sht2.Cells(Rows.Count, 9).End(xlUp).Offset(1, 0).PasteSpecial xlPasteValues
Application.CutCopyMode = False
'Application.ScreenUpdating = True
End If

If (Lastrow2 = "") Then
Sht3.Range("J2:J13").Copy
Sht2.Cells(Rows.Count, 9).End(xlUp).Offset(1, 0).PasteSpecial xlPasteValues
Application.CutCopyMode = False
'Application.ScreenUpdating = True
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, 4).Row

If (LastRow = Lastrow2) Then

Exit Sub
End If
End Sub

Answer 1

根据您的评论，我认为这应该可以解决问题......

Public Sub TransferData()
    Dim wb As Workbook
    Dim ws1 As Worksheet
    Dim ws2 As Worksheet

    Set wb = ActiveWorkbook

    Set ws1 = wb.Worksheets("Chapters") ' I'm assuming this is "Sheet 1"
    Set ws2 = wb.Worksheets("Practical results") ' I'm assuming this is "Sheet 2"

    Dim k As Range
    Dim lastCol1 As Integer
    Dim lastCol2 As Integer
    Dim i As Integer
    Dim j As Integer
    Dim r As Integer


    lastCol1 = ws1.Cells.SpecialCells(xlCellTypeLastCell).Column
    lastCol2 = ws2.Cells.SpecialCells(xlCellTypeLastCell).Column
    For i = 1 To lastCol1
        Dim machineNum As String
        machineNum = ws1.Cells(1, i).Value
        For j = 1 To lastCol2
            ' If they match, then print
            If ws2.Cells(1, j).Value = machineNum Then
                For r = 2 To 13 ' I am assuming you have one header row, 12 data rows
                    Set k = ws1.Cells(r, i)
                    ws2.Cells(r, j).Value = k.Value
                Next r
            End If
        Next j
    Next i

End Sub

if else条件excel vba

1 个答案: