工作表之间的循环 - 覆盖错误

Question

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

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

我已经为带有数组的工作表提供了一个范围，并写下了条件。 因此，它应该遵循代码中"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 

结束子

从"讽刺"循环开始的新版本代码如下;

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遍历代码时，您将鼠标悬停在变量上并查看值。