Question

我试图检查A表A列中的值，如果是，则B列中的值和C需要复制到表B中的A和B列。这需要循环，直到它检查了所有的值并检查所有行。代码执行但它只将值复制到同一个工作表上，而只对第一行值进行复制。我尝试过选择和激活但无济于事。代码如下：

Dim Count As Integer        'Count from workbook open
Dim CountVal As Integer
Dim Check As String        'check value for yes or no
Dim ufCheckvalue As Integer      'Gets go/nogo from userform
Dim Row1 As Integer         'row number for add/remove sheet
Dim Row2 As Integer         'row number for summary sheet
Dim SecNum As Integer       'value for section number
Dim Descrip As String   'value for description

ListCount = Range("B" & Rows.Count).End(xlUp).Row
Count = ListCount         'initalize values
CountVal = 0
Check = ""
ufCheckvalue = 0
Row1 = 10       'first row of values on add/remove sheet
Row2 = 5        'first row of values on summary sheet
SecNum = 0
Descrip = ""

ufContinue.Show       'user has to confirm it wants to run program
If ufCheckvalue = 1 Then
Unload ufContinue
    Do
    Check = Range(Cells(1, Row1)).Value                 'gets the check value
        If Check = "Yes" Then                           'checks to see if yes
            SecNum = Range(Cells(2, Row1)).Value        'sets values if yes
            Descrip = Range(Cells(3, Row1)).Value
            Sheets("Summary of Estimate").Select        'selects estimate page
            Selection.Activate                          'activates estimate page
            Range(Cells(1, Row2)).Select                'selects cell to insert value into
                Selection.Value = SecNum                'inserts value
            Range(Cells(2, Row2)).Select                'selects cell to insert value into
                Selection.Value = Descrip               'inserts value
            Sheets("Add-Remove").Select                 'goes back to original worksheet
            Row2 = Row2 + 1                             'adds one to row2 so it will index to next line
        End If
        Row1 = Row1 + 1                                 'changes rows for check value
        CountVal = CountVal + 1                         'adds one to count value
    Loop Until CountVal = Count                         'loops until it has looped countval number of times

ElseIf ufCheck = 0 Then                                 'makes the update button visible
Unload ufContinue
cmdUpdate.Visible = True    'Shows the update button
End If

如果真的没有意义，我会道歉。我在大学里学到了很多危险。

Answer 1

Set ws = Worksheets("Summary of Estimate")
Set ws2 = Worksheets("Add-Remove")
Dim i As Integer

For i = 1 To ws.Range("A" & Rows.Count).End(xlUp).Row
    If ws.Range("a" & i).Value = "Yes" Then
    ws.Range("b" & i).Value = ws2.Range("a" & i).Value
    ws.Range("c" & i).Value = ws2.Range("b" & i).Value
    End If
Next i

切换工作表以及从工作表A复制和粘贴到B的问题

1 个答案: