если еще условие excel vba

Question

Изображение 1: Это изображение для номера машины, если номер машины В листе практических результатов соответствует данным в номере машины в листе главы, данные должны быть скопированы в лист практических результатов Изображение 2: Номер машины в Практическом листе [Должен быть вставлен здесь в максимальный счет, если номер машины совпадает] Изображение 3: 3 У меня есть небольшой вопрос, связанный с Excel VBA.

У меня есть 3 листа в рабочей книге:

• лист1: главы
• sheet2: результаты Mcq и
• лист 3: практические результаты

Мой вопрос заключается в том, как использовать оператор if … else в Excel VBA, чтобы я хотел проверить столбец номеров машин на Листе 1 и снова перекрестно проверить номер машины на листе 2, если sheet1.Machinenumber = Sheet2.Machinenumber он должен заполнить все 12 строк от листа1 до листа2 столбец максимальной оценки.

Любые идеи приветствуются.

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