每次刷新宏工时和模号都会错乱掉

吴燕青

每次刷新宏工时和模号都会错乱掉模具工件工序工时里面就不准，求修复，帮忙看下哪里不对
Sub gs()
Sheet6.Range("A2:D90000").Clear
Sheet4.Range("A2:M90000").Clear
Sheet5.Select
Dim ar, ar1, ar3(), AR2(), AR4(), i, j, k, L, G, P As Long
n = Application.WorksheetFunction.CountA(Sheet5.Range("B:B")) + 2
i = Application.WorksheetFunction.CountA(Sheet5.Range("1:1")) - 13
ar = Sheet5.Range("b3", Cells(n, 2))
ar1 = Sheet5.Range(Cells(2, 8), Cells(n, 8))
j = 9 + i
For k = 1 To n - 2
ReDim Preserve AR2(1 To 1, 1 To i)
AR2 = Sheet5.Range(Cells(k + 1, 10), Cells(k + 1, j))
For G = 1 To i
If AR2(1, G) <> "" Then
L = L + 1
ReDim Preserve ar3(1 To 4, 1 To L)
ar3(1, L) = ar(k, 1)
ar3(2, L) = ar1(k, 1)
ar3(3, L) = Left(AR2(1, G), InStr(AR2(1, G), "(") - 1)
ar3(4, L) = Mid(AR2(1, G), InStr(AR2(1, G), "(") + 1, InStr(AR2(1, G), ")") - InStr(AR2(1, G), "(") - 1)
End If
Next
If k = 1 Then
P = P + 1
ReDim Preserve AR4(1 To 1, 1 To P)
AR4(1, P) = ar(k, 1)
End If
If k > 1 And ar(k, 1) <> ar(Application.WorksheetFunction.Max(k - 1, 1), 1) Then
P = P + 1
ReDim Preserve AR4(1 To 1, 1 To P)
AR4(1, P) = ar(k, 1)
End If
Next
Sheet6.Range("A2").Resize(L, 4) = Application.WorksheetFunction.Transpose(ar3)
Sheet4.Range("A2").Resize(P, 1) = Application.WorksheetFunction.Transpose(AR4)
Sheet4.Select
Sheet4.[B2].FormulaR1C1 = "=SUMIFS(模具工件工序工时!C4,模具工件工序工时!C3,R1C,模具工件工序工时!C1,RC1)"
Sheet4.Range("B2:M" & P).FillRight
If UBound(AR4) > 1 Then
Sheet4.Range("B2:M" & P).FillDown
End If
Sheet4.Range("B2:M" & P) = Sheet4.Range("B2:M" & P).Value
Sheet4.Range("B2:M" & P).NumberFormatLocal = "0.0!H;;"
Sheet4.[B2].Select
End Sub

吴燕青

有谁帮帮忙