Question

我有以下VBA代码来比较两个单元格之间的内容（字符串）。如果相同，则必须复制某些单元格并将其粘贴到另一张纸上。但是，此代码不起作用。请您提出调整建议？

Dim p As Integer
Dim i As Integer

For i = 12 To RealLastRow
If Worksheets("Pal_clave").Range("V" & i).Value = Worksheets("Pal_clave").Range("V" & i - 1).Value Then

Worksheets("Pal_clave").Range("D" & i).Copy Worksheets("Diagrama").Range("B" & p + 10)

Worksheets("Pal_clave").Range("K" & i).Copy Worksheets("Diagrama").Range("E" & p + 10)

Worksheets("Pal_clave").Range("T" & i).Copy Worksheets("Diagrama").Range("H" & p + 10)

Worksheets("Pal_clave").Range("V" & i).Copy Worksheets("Diagrama").Range("K" & p + 10)

Worksheets("Pal_clave").Range("AB" & i).Copy Worksheets("Diagrama").Range("N" & p + 10)

Worksheets("Pal_clave").Range("AJ" & i).Copy Worksheets("Diagrama").Range("B" & p + 20)

Worksheets("Pal_clave").Range("Y" & i).Copy Worksheets("Diagrama").Range("K" & p + 20)

p = p + 20

End If

Next i

Answer 1

可能您的某些子例程丢失了，但是您没有定义RealLastRow。您可以通过将长工作表名称设置为变量并避免复制/粘贴来缩短代码。最好不要使用上一个答案中使用的Select和Activate。

Sub LoopFor()

    'Use Long in case there are greater than 32767 rows
    Dim p As Long
    Dim i As Long
    Dim RealLastRow As Long
    Dim ws1 As Worksheet
    Dim ws2 As Worksheet

    'Makes your code shorter
    Set ws1 = ThisWorkbook.Sheets("Pal_clave")
    Set ws2 = ThisWorkbook.Sheets("Diagrama")

    'This will get you the last row, even if there are gaps in the data
    RealLastRow = ws1.Cells(Rows.Count, 1).End(xlUp).Row

    'You may want to test if there are more than 12 rows
    For i = 12 To RealLastRow
        If ws1.Range("V" & i).Value = ws1.Range("V" & i - 1).Value Then

            'No need to copy/paste
            ws2.Range("B" & p + 10) = ws1.Range("D" & i)
            ws2.Range("E" & p + 10) = ws1.Range("K" & i)
            ws2.Range("H" & p + 10) = ws1.Range("T" & i)
            ws2.Range("K" & p + 10) = ws1.Range("V" & i)
            ws2.Range("N" & p + 10) = ws1.Range("AB" & i)
            ws2.Range("B" & p + 20) = ws1.Range("AJ" & i)
            ws2.Range("K" & p + 20) = ws1.Range("Y" & i)

            p = p + 20

        End If

    Next i

End Sub

Answer 2

根据我的理解，您已经输入了sheet1，并希望比较A和B列中的单元格。如果字符串匹配，则从sheet1复制特定的单元格值并将其粘贴到sheet2。

您必须使用For循环和if条件来实现此目的。

请尝试以下代码。

Sub CompareAndCopy()

Dim NumberOfValues, i, j As Integer
Dim value1, value2 As String
j = 2

Sheet1.Activate
NumberOfValues = Sheets("Sheet1").Range("A1").End(xlDown).Row

For i = 1 To NumberOfValues

value1 = Range("A" & i).Value
value2 = Range("B" & i).Value

'Comparing the cell values in A and B column
'If value matches then copy and paste them into sheet2 from sheet1

If value1 = value2 Then   
Worksheets("Sheet1").Range("D" & i & ":H" & i).Copy Destination:=Worksheets("Sheet2").Range("A" & j)
Sheet1.Activate
j = j + 1
End If

Next

End Sub

循环用于比较两个单元格之间的内容并复制数据

2 个答案: