Question

我正在编写一个宏来从工作表中获取信息，以便将该信息写入vba中具有指定条件的另一个工作表。

但不幸的是，我的代码存在一个有趣的问题。

我已经使用Array为工作表提供了一个范围，并写下了条件。所以它应该与代码中的“hcr1”和“hcr2”的特定顺序一致。

如果WS_Name3，WS_Name4和WS_Name5的值不同，则一切正常并将数据写入其工作表。但是，如果其中2个值或全部3个相同，则会混淆宏并将最后一个值写入每一行。

假设WS_Name3和WS_Name4相同，WS_Name5为空，则hcr1值始终为20，即WS_Name4值。

这是所有代码;

Sub Atama() 


Application.ScreenUpdating = False 


Dim WS_Name As String 
Dim i As Integer 
For i = 23 To 34 
    WS_Name = Worksheets("Sheet1").Cells(i, 6).Value 
    Worksheets(WS_Name).Activate 


    Dim Acik_is As Long 
    For Acik_is = Cells(Rows.Count, 10).End(xlUp).Row To 2 Step -1 
        With Cells(Acik_is, 10) 
            If .Value = "Devam Ediyor" Or .Value = "Revize Devam Ediyor" Then Rows(Acik_is).EntireRow.Delete 
        End With 
    Next Acik_is 
Next i 


Dim lRow As Long 
Dim lLastRow As Long 
Dim WS_Name2 As String 
On Error Resume Next 
lRow = Application.WorksheetFunction.Match("Acik", Worksheets("Egitim Bilgileri").Range("BR2:BR20"), 0) + 1 
On Error Goto 0 


If lRow > 0 Then 


    WS_Name2 = Worksheets("Egitim Bilgileri").Cells(lRow, 1).Value 
    Worksheets(WS_Name2).Activate 


    lLastRow = WorksheetFunction.Max(Worksheets(WS_Name2).Range("AA22:AA1100")) 
    lLastrow2 = lLastRow + 21 




    For Satir = 22 To lLastrow2 
        With Cells(Satir, 26) 
            If .Value = "" Then 
                WS_Name3 = Worksheets(WS_Name2).Cells(Satir, 16).Value 
                WS_Name4 = Worksheets(WS_Name2).Cells(Satir, 19).Value 
                WS_Name5 = Worksheets(WS_Name2).Cells(Satir, 22).Value 
            End If 



            Dim WS_X_Code As Variant 
            For Each WS_X_Code In Array(WS_Name3, WS_Name4, WS_Name5) 




                If WS_X_Code = WS_Name3 Then hcr1 = 17 
                If WS_X_Code = WS_Name4 Then hcr1 = 20 
                If WS_X_Code = WS_Name5 Then hcr1 = 23 
                hcr2 = hcr1 + 1 

                RowCount = Worksheets(WS_X_Code).Cells(Rows.Count, 1).End(xlUp).Row 
                On Error Resume Next 

                With Worksheets(WS_X_Code) 
                    NextRow = .Range("A" & .Rows.Count).End(xlUp).Row + 1 


                    Worksheets(WS_Name2).Cells(2, 3).Copy 
                    Worksheets(WS_X_Code).Cells(NextRow, 1).PasteSpecial Paste:=xlPasteValues 
                    Worksheets(WS_Name2).Cells(Satir, hcr1).Copy 
                    Worksheets(WS_X_Code).Cells(NextRow, 3).PasteSpecial Paste:=xlPasteValues 
                    Worksheets(WS_Name2).Cells(Satir, hcr2).Copy 
                    Worksheets(WS_X_Code).Cells(NextRow, 4).PasteSpecial Paste:=xlPasteValues 
                    Worksheets(WS_Name2).Cells(Satir, 34).Copy 
                    Worksheets(WS_X_Code).Cells(NextRow, 2).PasteSpecial Paste:=xlPasteValues 
                    Worksheets(WS_X_Code).Cells(NextRow, 6).FormulaR1C1 = _ 
                    "=IFERROR(IF(AND(R[-1]C="""",R[-1]C[2]=""""),"""",WORKDAY(IF(R[-1]C="""",R[-1]C[2],R[-1]C),(SUM(R4C4:RC[-2])/7))),"""")" 
                    Worksheets(WS_X_Code).Cells(NextRow, 10).FormulaR1C1 = _ 
                    "=IF(RC[-2]="""",IF(RC[-4]="""","""",IF(RC[-3]<>"""",""Üretim Tamamlandi"",""Devam Ediyor"")),IF(RC[-1]<>"""",""Revize Tamamlandi"",""Revize Devam Ediyor""))" 




                End With 
            Next WS_X_Code 



        End With 
    Next Satir 

End If

End Sub

从“Satir”循环开始的新版代码如下;

    For Satir = 22 To lLastrow2
    With Cells(Satir, 26)
         If .Value = "" Then
             WS_Name3 = Worksheets(WS_Name2).Cells(Satir, 16).Value
             WS_Name4 = Worksheets(WS_Name2).Cells(Satir, 19).Value
             WS_Name5 = Worksheets(WS_Name2).Cells(Satir, 22).Value
         End If


            Dim WS_X_Code As Variant
            Dim X As Integer
            For Each WS_X_Code In Array(WS_Name3, WS_Name4, WS_Name5)

                Select Case X
                    Case 0: hcr1 = 17
                    Case 1: hcr1 = 20
                    Case 2: hcr1 = 23
                End Select
            hcr2 = hcr1 + 1

            RowCount = Worksheets(WS_X_Code).Cells(Rows.Count, 1).End(xlUp).Row
            On Error Resume Next

            With Worksheets(WS_X_Code)
            NextRow = .Range("A" & .Rows.Count).End(xlUp).Row + 1

                Worksheets(WS_Name2).Cells(2, 3).Copy
                Worksheets(WS_X_Code).Cells(NextRow, 1).PasteSpecial Paste:=xlPasteValues
                Worksheets(WS_Name2).Cells(Satir, hcr1).Copy
                Worksheets(WS_X_Code).Cells(NextRow, 3).PasteSpecial Paste:=xlPasteValues
                Worksheets(WS_Name2).Cells(Satir, hcr2).Copy
                Worksheets(WS_X_Code).Cells(NextRow, 4).PasteSpecial Paste:=xlPasteValues
                Worksheets(WS_Name2).Cells(Satir, 34).Copy
                Worksheets(WS_X_Code).Cells(NextRow, 2).PasteSpecial Paste:=xlPasteValues
                Worksheets(WS_X_Code).Cells(NextRow, 6).FormulaR1C1 = _
        "=IFERROR(IF(AND(R[-1]C="""",R[-1]C[2]=""""),"""",WORKDAY(IF(R[-1]C="""",R[-1]C[2],R[-1]C),(SUM(R4C4:RC[-2])/7))),"""")"
                 Worksheets(WS_X_Code).Cells(NextRow, 10).FormulaR1C1 = _
        "=IF(RC[-2]="""",IF(RC[-4]="""","""",IF(RC[-3]<>"""",""Üretim Tamamlandi"",""Devam Ediyor"")),IF(RC[-1]<>"""",""Revize Tamamlandi"",""Revize Devam Ediyor""))"


        X = X + 1
        End With
        Next WS_X_Code


End With
Next Satir

End If

End Sub

Answer 1

所以你的错误出现在IF语句中。

If WS_X_Code = WS_Name3 Then hcr1 = 17 
If WS_X_Code = WS_Name4 Then hcr1 = 20 
If WS_X_Code = WS_Name5 Then hcr1 = 23

您想要与名称进行比较，但实际上它与值进行比较，因此如果有相同的值，它将与前一个值一致，如您所述。

解决此问题的一种方法是使用这样的计数器：

Dim WS_X_Code As Variant
Dim i As Integer: i = 0

For Each WS_X_Code In Array(WS_Name3, WS_Name4, WS_Name5)
    Select Case i
        Case 0: hcr1 = 17
        Case 1: hcr1 = 20
        Case 2: hcr1 = 23
    End Select

'i.e
Worksheets(WS_Name2).Cells(2, 3).Copy
Worksheets(WS_X_Code).Cells(NextRow, 1).PasteSpecial Paste:=xlPasteValues
'....

i = i + 1
Next WS_X_Code

下次我建议您使用F8查看代码，然后将鼠标悬停在变量上并查看值。

工作表之间循环 - 写入错误

1 个答案: