B欄的日期>=VBA工作表的AF2

K3=k2+g3-f3-h3-i3+j3

For Each xR In Range([B3], [b65535].End(3))
If xR >= d Then 'k+g-f-h-i+j
xR.Offset(, 9) = xR.Offset(-1, 9) + xR.Offset(, 5) - xR.Offset(, 4) - xR.Offset(, 6) - xR.Offset(, 7) + xR.Offset(, 8)
End If
Next

1. 計算後變成值
2. 計算後保留公式
[attach]34052[/attach]

Sub test()
Dim d, R%
d = Sheets("VBA").[Af2]
R = [北區!a65536].End(3).Row
With [北區!k3].Resize(R - 2)
.Formula = "=K2+G3-F3-H3-I3+J3"
'.Value = .Value '轉為值
End With
End Sub

C欄"供應商"分為大 & 美

1) 為什麼程式,它能自動找到>=d的日期,進行計算呢?
d = Sheets("VBA").[Af2]

2) A欄,要取B欄的年月,YYYY..M

xR.Offset(, -1) = Year(xR) & ".." & Month(xR)

.Formula = "=Format([b3], "YYYY") & ".." & Format([b3], "M")"

d = Sheets("VBA").[Af2]

1) 為什麼程式,它能自動找到>=d的日期,進行計算呢?
>> 不好意思，我沒注意到有這個條件，已更新如下，請測試看看，謝謝

2) A欄,要取B欄的年月,YYYY..M
>> 已更新如下，謝謝

Sub test()
Dim Arr, d, R%
d = Sheets("VBA").[Af2]
R = [北區!b65536].End(3).Row
With Sheets("北區").Range("a1:k" & R)
Arr = .Value
For i = 3 To UBound(Arr)
.Cells(i, "a").Formula = "=YEAR(RC[1]) & "".."" & MONTH(RC[1])"
If Arr(i, 2) >= d Then
.Cells(i, "k").Formula = "=R[-1]C+RC[-4]-RC[-5]-RC[-3]-RC[-2]+RC[-1] "
End If
Next
'.Value = .Value '轉為值
End With
End Sub

C欄"供應商"分為大 & 美

PJChen 發表於 2021-9-23 19:34

Sub 刪除列()
Dim Arr, i&, j%, n%
With Sheets("北區")
With Range(.[k3], .[a65536].End(3))
Arr = .Value
For i = 1 To UBound(Arr)
If Arr(i, 3) <> "美" Then GoTo 99
n = n + 1
For j = 1 To UBound(Arr, 2)
Arr(n, j) = Arr(i, j)
Next
99:     Next
.Clear
End With
With Range("a3").Resize(n, UBound(Arr, 2))
.Value = Arr
.Borders(xlBottom).Weight = xlHairline
End With
End With
End Sub

C欄"供應商"分為大 & 美

PJChen 發表於 2021-9-23 19:34

Sub 刪除列2()
Dim xR As Range, xU As Range
For Each xR In Range("c3:c" & [c65536].End(3).Row).Rows
If IsError(Application.Match("美", xR, 0)) Then
If xU Is Nothing Then Set xU = xR Else Set xU = Union(xR, xU)
End If
Next
If Not xU Is Nothing Then xU.EntireRow.Delete
End Sub

xR.Offset(, 9) = xR.Offset(-1, 9) + xR.Offset(, 5) - xR.Offset(, 4) - xR.Offset(, 6) - xR.Offset(, 7) + xR.Offset(, 8)

Sub test()
Dim Arr, d, R%
d = Sheets("VBA").[Af2]
R = [北區!b65536].End(3).Row
With Sheets("北區").Range("a1:k" & R)
With [a3].Resize(R - 2)
.Formula = "=YEAR(B3) & "".."" & MONTH(B3)"
End With
.Value = .Value '轉為值
Arr = .Value
For i = 3 To UBound(Arr)
If Arr(i, 2) >= d Then
.Cells(i, "k").Formula = "=k" & i - 1 & "+G" & i & "-F" & i & "-H" & i & "-I" & i & "+j" & i
End If
Next
'.Value = .Value '轉為值
End With
End Sub

C欄"供應商"分為大 & 美

>> 請問#7、#8可以用嗎?

For Each xR In Range([B3], [b65535].End(3))
If xR >= d Then 'k+g-f-h-i+j
xR.Offset(, 9) = xR.Offset(-1, 9) + xR.Offset(, 5) - xR.Offset(, 4) - xR.Offset(, 6) - xR.Offset(, 7) + xR.Offset(, 8)
End If
Next

A欄,要取B欄的年月,YYYY..M

#6
.Cells(i, "a").Formula = "=YEAR(RC[1]) & "".."" & MONTH(RC[1])"

#10
.Formula = "=YEAR(B3) & "".."" & MONTH(B3)"

#10
.Formula = "=YEAR(B3) & "".."" & MONTH(B3)"

>> With [a3].Resize(R - 2)
.Formula = "=YEAR(B3) & "".."" & MONTH(B3)"
End With
.Value = .Value '轉為值

Sub test()
Dim Arr, d, R%
d = Sheets("VBA").[Af2]
R = [北區!b65536].End(3).Row
With Sheets("北區").Range("a1:k" & R)
'    With [a3].Resize(R - 2)
'    .Formula = "=YEAR(B3) & "".."" & MONTH(B3)"
'    End With
'    .Value = .Value '轉為值
Arr = .Value
For i = 3 To UBound(Arr)
If Arr(i, 2) >= d Then
.Cells(i, "a").Formula = "=YEAR(RC[1]) & "".."" & MONTH(RC[1])"
.Cells(i, "k").Formula = "=k" & i - 1 & "+G" & i & "-F" & i & "-H" & i & "-I" & i & "+j" & i
End If
Next
'.Value = .Value '轉為值
End With
End Sub

#10
.Formula = "=YEAR(B3) & "".."" & MONTH(B3)"

>> With [a3].Resize(R - 2)
.Formula = "=YEAR(B3) & "".."" & MONTH(B3)"
End With
.Value = .Value '轉為值

Sub test()
Dim Arr, d, R%
d = Sheets("VBA").[Af2]
R = [北區!b65536].End(3).Row
With Sheets("北區").Range("a1:k" & R)
'    With [a3].Resize(R - 2)
'    .Formula = "=YEAR(B3) & "".."" & MONTH(B3)"
'    End With
'    .Value = .Value '轉為值
Arr = .Value
For i = 3 To UBound(Arr)
If Arr(i, 2) >= d Then
.Cells(i, "a").Formula = "=YEAR(RC[1]) & "".."" & MONTH(RC[1])"
.Cells(i, "k").Formula = "=k" & i - 1 & "+G" & i & "-F" & i & "-H" & i & "-I" & i & "+j" & i
End If
Next
'.Value = .Value '轉為值
End With
End Sub

E欄要填入單號(連結)T&S&R

If Arr(i, 2) >= d And Arr(i, "r") = "" Then 'Arr(i, 2),第2欄是日期,R欄無單號
.Cells(i, "e").Formula = "無交貨"
Else
.Cells(i, "e").Formula = "=T&S&R"
End If
Next

For i = 3 To UBound(Arr)
If Arr(i, 2) >= d And Arr(i, 4) <> "中和" Or Arr(i, 4) <> "內湖" And Arr(i, 4) <> "汐止" Then 'i=列
.Cells(i, "u").Formula = "=Arr(i, 2)" + 1

ElseIf Arr(i, 2) >= d And Arr(i, 4) = "中和" Or Arr(i, 4) = "內湖" And Arr(i, 4) = "汐止" Then
.Cells(i, "u").Formula = "Arr(i, 2)"
End If
Next

E欄要填入單號(連結)T&S&R

>> 依據您的程式做修改如下
If Arr(i, 2) >= d And Arr(i, 18) = "" Then 'Arr(i, 2),第2欄是日期,R欄無單號
.Cells(i, "e") = "無交貨"
Else
.Cells(i, "e").Formula = "=T" & i & " & S" & i & "& R" & i & ""
End If

If Arr(i, 2) >= d And Arr(i, 18) = "" Then 'Arr(i, 2),第2欄是日期,R欄無單號
.Cells(i, "e") = "無交貨"
end if
If Arr(i, 2) >= d And Arr(i, 18) <> "" Then
.Cells(i, "e").Formula = "=T" & i & " & S" & i & "& R" & i & ""
end if

If Arr(i, 2) >= d And Arr(i, 4) <> "中和" Or Arr(i, 4) <> "內湖" And Arr(i, 4) <> "汐止" Then 'i=列
.Cells(i, "u").Formula = "=B" & i & " +1 "
ElseIf Arr(i, 2) >= d And Arr(i, 4) = "中和" Or Arr(i, 4) = "內湖" And Arr(i, 4) = "汐止" Then
.Cells(i, "u").Formula = "=B" & i & ""
End If

U & E欄的問題都解決了,

~~~~~~~~~

V3=IF(COUNTIFS(北區!\$B\$2:\$B3,北區!\$B3,北區!\$D\$2:\$D3,北區!\$D3)=1,SUMIFS(北區!\$W:\$W,北區!\$B:\$B,北區!\$B3,北區!\$D:\$D,北區!\$D3)-SUMIFS(北區!\$F:\$F,北區!\$B:\$B,北區!\$U3,北區!\$D:\$D,北區!\$D3),0)

>> 改為單獨欄轉為值
Range("K3:K" & R).Value = Range("K3:K" & R).Value    'K欄轉為值

V3=IF(COUNTIFS(北區!\$B\$2:\$B3,北區!\$B3,北區!\$D\$2:\$D3,北區!\$D3)=1,SUMIFS(北區!\$W:\$W,北區!\$B:\$B,北區!\$B3,北區!\$D:\$D,北區!\$D3)-SUMIFS(北區!\$F:\$F,北區!\$B:\$B,北區!\$U3,北區!\$D:\$D,北區!\$D3),0)
>> 這是要做什麼??不知道您實際需求是什麼?

H欄要統計D欄每個月最後一個日期的月統計數量

,請問這程式要怎麼寫？
[attach]34077[/attach]

H欄要統計D欄每個月最後一個日期的月統計數量
>> 如下，請測試看看，謝謝
Sub test()
Dim Arr, Brr, xD, i&, T\$, T1\$
Arr = Sheets("中區").Range("a3:k" & [中區!a65536].End(3).Row + 1)
ReDim Brr(1 To UBound(Arr), 1 To 1)
Set xD = CreateObject("Scripting.Dictionary")
For i = 1 To UBound(Arr)
If Not IsDate(Arr(i, 1)) Then GoTo 98
T = Month(Arr(i, 1)): T1 = Month(Arr(i + 1, 1))
If xD.Exists(T) Then
If T <> T1 Then
xD(Arr(i, 1) & "_" & Arr(i, 3)) = Val(xD(T)) + Val(Arr(i, 4))
Else
xD(T) = Val(xD(T)) + Val(Arr(i, 4))
End If
Else
xD(T) = Val(Arr(i, 4))
End If
98: Next
For Each ky In xD.keys
For i = 1 To UBound(Arr)
Brr(i, 1) = xD(Arr(i, 1) & "_" & Arr(i, 3))
Next
Next
Sheets("中區").[h3].Resize(UBound(Brr)) = Brr
End Sub

xD(Arr(i, 1) & "_" & Arr(i, 3)) = Val(xD(T)) + Val(Arr(i, 4))
Sub test()
Dim Arr, Brr, xD, i&, T\$, T1\$
Arr = Sheets("中區").Range("a3:k" & [中區!a65536].End(3).Row + 1)
ReDim Brr(1 To UBound(Arr), 1 To 1)
Set xD = CreateObject("Scripting.Dictionary")
For i = 1 To UBound(Arr)
If Not IsDate(Arr(i, 1)) Then GoTo 98
T = Month(Arr(i, 1)): T1 = Month(Arr(i + 1, 1))
If xD.Exists(T) Then
If T <> T1 Then
xD(Arr(i, 1) & "_" & Arr(i, 3)) = Val(xD(T)) + Val(Arr(i, 4))
Else
xD(T) = Val(xD(T)) + Val(Arr(i, 4))
End If
Else
xD(T) = Val(Arr(i, 4))
End If
98: Next
For Each ky In xD.keys
For i = 1 To UBound(Arr)
Brr(i, 1) = xD(Arr(i, 1) & "_" & Arr(i, 3))
Next
Next
Sheets("中區").[h3].Resize(UBound(Brr)) = Brr
End Sub

Sub test()
Dim Arr, Brr, xD, i&, T\$, T1\$
Arr = Sheets("中區").Range("a3:k" & [中區!a65536].End(3).Row + 1) '資料裝入陣列
ReDim Brr(1 To UBound(Arr), 1 To 1) '創空的陣列用來裝答案
Set xD = CreateObject("Scripting.Dictionary")
For i = 1 To UBound(Arr)
If Not IsDate(Arr(i, 1)) Then GoTo 98   '不是日期離開
T = Month(Arr(i, 1)): T1 = Month(Arr(i + 1, 1))
If xD.Exists(T) Then    '是否A欄月份有在字典
If T <> T1 Then '自己與下一列日期的月份比較
'紀錄當月最後一筆的交板數量累加，key:最後日期_採購單號，避免最後一天有多筆
xD(Arr(i, 1) & "_" & Arr(i, 3)) = Val(xD(T)) + Val(Arr(i, 4))
Else
xD(T) = Val(xD(T)) + Val(Arr(i, 4)) '同月份交板數量累加
End If
Else
xD(T) = Val(Arr(i, 4)) '交板數量裝入字典
End If
98: Next
For Each ky In xD.keys  '字典keys循環
For i = 1 To UBound(Arr)
Brr(i, 1) = xD(Arr(i, 1) & "_" & Arr(i, 3)) '字典key:最後日期_採購單號，裝入答案陣列
Next
Next
Sheets("中區").[h3].Resize(UBound(Brr)) = Brr  '顯示答案
End Sub

[attach]34132[/attach]

>> 更改如下，請測試看看，謝謝。
T = Year(Arr(i, 1)) & "|" & Month(Arr(i, 1)): T1 = Year(Arr(i, 1)) & "|" & Month(Arr(i + 1, 1))

[attach]34161[/attach]

>> 更新如下紅字，請再測試看看，謝謝。
For Each ky In xD.keys
For i = 1 To UBound(Arr)
If i < UBound(Arr) Then
If Arr(i, 1) & "_" & Arr(i, 3) = Arr(i, 1) & "_" & Arr(i + 1, 3) Then GoTo 99
End If
Brr(i, 1) = xD(Arr(i, 1) & "_" & Arr(i, 3))
99: Next
Next

1) A欄每月第一筆日期,不一定1日開始
2) A欄每月最後一筆也不一定是月底日,只要是每月的最後出現的日期就進行統計
3) 要把年度也考量進去,因為資料會不斷增加,不會只有一個年度
4) C欄的單號,會有同一日期,同一單號重複數次,我想程式中應該不用加上C欄的判別,因為單號與統計無關

Dim Arr, Brr, xD, i&, T\$, T1\$
Arr = Sheets("中區").Range("a3:k" & [中區!a65536].End(3).Row + 1)
ReDim Brr(1 To UBound(Arr), 1 To 1)
Set xD = CreateObject("Scripting.Dictionary")
For i = 1 To UBound(Arr)
If Not IsDate(Arr(i, 1)) Then GoTo 98
T = Year(Arr(i, 1)) & "|" & Month(Arr(i, 1)): T1 = Year(Arr(i, 1)) & "|" & Month(Arr(i + 1, 1))

If xD.Exists(T) Then
If T <> T1 Then
xD(Arr(i, 1)) = Val(xD(T)) + Val(Arr(i, 4))
Else
xD(T) = Val(xD(T)) + Val(Arr(i, 4))
End If
Else
xD(T) = Val(Arr(i, 4))
End If
98: Next
'--------
For Each ky In xD.keys
For i = 1 To UBound(Arr)
If i < UBound(Arr) Then
If Arr(i, 1) = Arr(i + 1, 1) Then GoTo 99
End If
Brr(i, 1) = xD(Arr(i, 1))
99: Next
Next
Sheets("中區").[h3].Resize(UBound(Brr)) = Brr
End Sub

1) A欄每月第一筆日期,不一定1日開始
2) A欄每月最後一筆也不一定是月底日,只要是每月的最後出現的日期就進行統計
3) 要把年度也考量進去,因為資料會不斷增加,不會只有一個年度
4) C欄的單號,會有同一日期,同一單號重複數次,我想程式中應該不用加上C欄的判別,因為單號與統計無關
>> 您真的很用心把所有規則條件列出，35#有小問題我修改後如下，請再測試看看，謝謝
Sub test2()
Dim Arr, Brr, xD, i&, T\$, T1\$
Arr = Sheets("中區").Range("a3:k" & [中區!a65536].End(3).Row + 1)
ReDim Brr(1 To UBound(Arr), 1 To 1)
Set xD = CreateObject("Scripting.Dictionary")
For i = 1 To UBound(Arr)
If Not IsDate(Arr(i, 1)) Then GoTo 98
T = Year(Arr(i, 1)) & "|" & Month(Arr(i, 1)): T1 = Year(Arr(i, 1)) & "|" & Month(Arr(i + 1, 1))
If xD.Exists(T) Then
If T <> T1 Then
xD(Arr(i, 1)) = Val(xD(T)) + Val(Arr(i, 4))
Else
xD(T) = Val(xD(T)) + Val(Arr(i, 4))
End If
Else
xD(T) = Val(Arr(i, 4))
End If
98: Next
For Each ky In xD.keys
For i = 1 To UBound(Arr)
If Not IsDate(Arr(i, 1)) Then GoTo 99
T = Year(Arr(i, 1)) & "|" & Month(Arr(i, 1)): T1 = Year(Arr(i, 1)) & "|" & Month(Arr(i + 1, 1))
If T <> T1 Then Brr(i, 1) = xD(Arr(i, 1))

99: Next
Next
Sheets("中區").[h3].Resize(UBound(Brr)) = Brr
End Sub

Sam

1) B欄>=[af1]
2) C欄<>"美"
[attach]34335[/attach]
1. Sub 刪除列2()
2. Dim xR As Range, xU As Range
3. For Each xR In Range("c3:c" & [c65536].End(3).Row).Rows
4.     If IsError(Application.Match("美", xR, 0)) Then
5.         If xU Is Nothing Then Set xU = xR Else Set xU = Union(xR, xU)
6.     End If
7. Next
8. If Not xU Is Nothing Then xU.EntireRow.Delete
9. End Sub

Sub 刪rows()
f = Columns("A:G").Find("*", , -4163, , 1, 2).Row
dt = [AF1]
Dim x1 As Range, x As Range
For i = 3 To f
If DateValue(Cells(i, 2)) >= DateValue(dt) And Cells(i, 3) <> "美" Then
Set x = Rows(i)
If x1 Is Nothing Then Set x1 = x
If Not x1 Is Nothing Then Set x1 = Union(x1, x)
End If
Next
If Not x1 Is Nothing Then x1.Delete
End Sub

1.建議用兩個日期判斷起始與結束 當前只有一個
2.原始檔案不建議做任何修改 建議vba產生的所有步驟(新修刪改) 將資料複製處理 放置到一個新增的工作表做處理(至少有原始檔案 避免操作錯誤無法倒回資料初始狀態,而且還可以做前後比對 效率提升)
3.原始資料(北區)不建議放公式 但新增的工作表可以放
VBA也會好寫很多

Sub 刪除列()
Dim xR As Range, xU As Range
For Each xR In Range("c3:c" & [c65536].End(3).Row).Rows
If xR = "美" Then GoTo 99
If xR.Offset(, -1) < [AF1] Then GoTo 99
Set xC = xR
If xU Is Nothing Then Set xU = xR Else Set xU = Union(xR, xU)
99: Next
If Not xU Is Nothing Then xU.EntireRow.Delete
End Sub

Sam 晚上好,

If xR.Offset(, -1) < [AF1] And xR.Offset(, -1) < [AF2] Then GoTo 99

[attach]34344[/attach]

If xR.Offset(, -1) > [AF1] And xR.Offset(, -1) < [AF2] Then GoTo 99

Sub 刪除列()
Dim D(2) As Date, K%, MS\$, xR As Range, xU As Range, N&
If IsDate([AF1]) Then D(1) = [AF1]: K = 1
If IsDate([AF2]) Then D(2) = [AF2]: K = K + 2
If K = 0 Then MsgBox "※未指定刪除日期! ": Exit Sub
If K = 1 Then D(2) = D(1): MS = D(1) & " 之後的資料"
If K = 2 Then D(1) = D(2): MS = D(2) & " 之前的資料"
If K = 3 Then
If D(2) < D(1) Then D(0) = D(1): D(1) = D(2): D(2) = D(0)
MS = D(1) & " 至 " & D(2) & " 之間的資料"
If D(1) = D(2) Then MS = D(1) & " 當天的資料"
End If
If MsgBox("※確定要刪除 " & MS & "？  ", 1 + 32 + 256) = vbCancel Then Exit Sub
'---------------------------------------------
For Each xR In Range([c3], [c65536].End(3))
If xR = "美" Or IsDate(xR(1, 0)) = False Then GoTo 99
D(0) = xR(1, 0)
If D(0) < D(1) Or D(0) > D(2) Then GoTo 99
N = N + 1
If N = 1 Then Set xU = xR Else Set xU = Union(xR, xU)
99: Next
If N = 0 Then MsgBox "※執行完畢! 找不到符合的資料!  ": Exit Sub
xU.Select
If MsgBox("※執行完畢! 共找到 " & N & " 筆符合資料，是否要刪除？  ", 4 + 32 + 256) = vbYes Then xU.EntireRow.Delete
End Sub

[attach]34356[/attach]

'==================================

If xR = "美" Then GoTo 99
If xR.Offset(, -1) > [AF1] And xR.Offset(, -1) < [AF2] Then GoTo 99'這行的寫法,會導致執行結果錯誤

1. For Each xR In Range("c3:c" & [c65536].End(3).Row).Rows
2.     If xR = "美" Then GoTo 99
3.     If xR.Offset(, -1) < [AF1] Then GoTo 99
4.     If xR.Offset(, -1) > [AF2] Then GoTo 99
5.     Set xC = xR
6.     If xU Is Nothing Then Set xU = xR Else Set xU = Union(xR, xU)
7. 99: Next
8. If Not xU Is Nothing Then xU.EntireRow.Delete

If xR.Offset(, -1) < [AF1] Or xR.Offset(, -1) > [AF2] Then GoTo 99

Sam您好,

[attach]34567[/attach]
1. Sub test()
2. Dim Arr, Brr, xD, i&, T\$, T1\$
3. Arr = Sheets("南區").Range("a3:k" & [中區!a65536].End(3).Row + 1)
4. ReDim Brr(1 To UBound(Arr), 1 To 1)
5. Set xD = CreateObject("Scripting.Dictionary")
6. For i = 1 To UBound(Arr)
7.     If Not IsDate(Arr(i, 1)) Then GoTo 98
8.     T = Year(Arr(i, 1)) & "|" & Month(Arr(i, 1)): T1 = Year(Arr(i, 1)) & "|" & Month(Arr(i + 1, 1))
9.     If xD.Exists(T) Then
10.         If T <> T1 Then
11.             xD(Arr(i, 1)) = Val(xD(T)) + Val(Arr(i, 4))
12.         Else
13.             xD(T) = Val(xD(T)) + Val(Arr(i, 4))
14.         End If
15.     Else
16.         xD(T) = Val(Arr(i, 4))
17.     End If
18. 98: Next
19. For Each ky In xD.keys
20.     For i = 1 To UBound(Arr)
21.         If Not IsDate(Arr(i, 1)) Then GoTo 99
22.         T = Year(Arr(i, 1)) & "|" & Month(Arr(i, 1)): T1 = Year(Arr(i, 1)) & "|" & Month(Arr(i + 1, 1))
23.         If T <> T1 Then Brr(i, 1) = xD(Arr(i, 1))
24. 99: Next
25. Next
26. Sheets("南區").[i3].Resize(UBound(Brr)) = Brr
27. End Sub

Sub test()
Dim Arr, Brr, xD, i&, T\$, T1\$
Arr = Sheets("南區").Range("a3:k" & [南區!a65536].End(3).Row)
ReDim Brr(1 To UBound(Arr), 1 To 1)
Set xD = CreateObject("Scripting.Dictionary")
For i = 1 To UBound(Arr)
If Not IsDate(Arr(i, 1)) Then GoTo 98
T = Year(Arr(i, 1)) & "|" & Month(Arr(i, 1))
If i < UBound(Arr) Then T1 = Year(Arr(i, 1)) & "|" & Month(Arr(i + 1, 1)) Else T1 = 0
If xD.Exists(T) Then
If T <> T1 Then
xD(Arr(i, 1)) = Val(xD(T)) + Val(Arr(i, 4))
Brr(i, 1) = xD(Arr(i, 1))
Else
xD(T) = Val(xD(T)) + Val(Arr(i, 4))
End If
Else
xD(T) = Val(Arr(i, 4))
End If
98: Next
Sheets("南區").[i3].Resize(UBound(Brr)) = Brr
End Sub

 歡迎光臨 麻辣家族討論版版 (http://forum.twbts.com/)