Question

下面是我的代码，我试图强制检查从第一个单元格开始，但它不起作用。任何人都可以告诉我这个。感谢

我正在尝试检查工作簿A第3列上的名称，并将其与另一个工作簿中的其他列进行比较。在匹配字符串时，它会将某些单元格复制到脱盐列

Sub copyandpaste()

Set From_WS = Workbooks("copy_data2").Worksheets("Data")
Set To_WS = Workbooks("Book1").Worksheets("Sheet1")
Dim v1 As String
Dim v2 As String
Dim diffRow As Long
Dim dataWs As Worksheet
Dim copyWs As Worksheet
Dim rowData As Long
Dim totRows As Long
Dim lastRow As Long
Dim result As String
Dim row_no As Integer
Dim Name As Range
Dim Namelist As Range
diffRow = 1 'compare
Set dataWs = Worksheets("Data")
Set copyWs = Worksheets("Diff")


For Each c In Worksheets("Data").Range("C2:C10")
    If c.Value <> "" Then
    v1 = c
End If

For Each d In Workbooks("Book1").Worksheets("Sheet1").Range("B2:B10")
    If d.Value <> "" Then
    v2 = d
End If


With From_WS.Cells(1, 2).CurrentRegion
    Total_Rows = .Rows.Count
    Total_Columns = .Columns.Count
End With

Set mycellA = From_WS.Range("C:C")
Set mycellB = To_WS.Range("B:B")


Copy = False

        ' With Sheets("copy_data2")
        ' lastRow = .Range("A" & .Rows.Count).End(xlUp).Row

        'find first row
        'column1 = Range("A2").End(xlToRight).Column


        'For row_no = 1 To 10
    '=========================================================================

    Set Namelist = dataWs.Range("A1:A" & dataWs.Cells(Rows.Count, "A").End(xlUp).Row)

    'Now loop through all the cells in the range
    'For Each Name In Namelist.Cells

    mynumber = 1
    For Each Name In Namelist
    '=======================================================================
        If v1 = v2 Then

        'select sheet
        Sheets("Data").Select

        'ActiveCell.Select 'select active cell
        ActiveCell.Interior.ColorIndex = 36 'color the cell

        'copy active cell same row
        ActiveCell.Range("A1:F1").Copy
        ActiveCell.Interior.ColorIndex = 50 'color the cell

        'Paste file destination
        Sheets("Diff").Select

        Sheets("Diff").Range("A2").Select

        'Paste Active
        ActiveSheet.Paste
        ActiveCell.Interior.ColorIndex = 37 '<< Colored Blue
        '==================================================================
        'select sheet
        Sheets("Data").Select

        'ActiveCell.Select 'select active cell
        ActiveCell.Interior.ColorIndex = 36 'color cell Yellow

        'result = ActiveCell.EntireRow.copy

        'copy active cell same row
        ActiveCell.Range("H1:J1").Copy

        'Paste file destination
        Sheets("Diff").Select

        'Paste cell destination
        Sheets("Diff").Range("G2").Select

        'Paste Active
        ActiveSheet.Paste
        mynumber = mynumber + 1
    End If
    Next Name



Next d
Next c


End Sub

这是第二个计算和遍历行的函数。

Sub RoundToZero1()
    For Counter = 1 To 20
        Set curCell = Worksheets("Data").Cells(Counter, 3)
        If Abs(curCell.Value) < 0.01 Then curCell.Value = 0
    Next Counter
End Sub

更新问题：

我有下面的代码，我需要使A列成为增量。有人建议如何实现这个目标吗？

Sheets("Diff").Range("A").Select

Answer 1

行Set selectedCell = selectedCell + 1在运行时会抛出错误，并且似乎没有在代码中执行任何操作，如果是这种情况，您应该将其注释掉或删除它。

另外我认为你需要改变

Else
If IsEmpty(Cells(i, 1)) = True Then 'if cells in column "A" is empty then stop

到

ElseIf IsEmpty(Cells(i, 1)) = True Then 'if cells in column "A" is empty then stop

目前，你有一个额外开放的If语句。

VBA如何从第一个单元格/列循环（强制它）

1 个答案: