samwang

回復 1# PJChen

請測試看看，謝謝

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

samwang

回復 4# PJChen

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

samwang

回復  samwang

您好,
測試沒問題,另外想請教
同一個檔案
C欄"供應商"分為大 & 美
從第3列開始,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

samwang

回復  samwang

您好,
測試沒問題,另外想請教
同一個檔案
C欄"供應商"分為大 & 美
從第3列開始,C欄美 ...
PJChen 發表於 2021-9-23 19:34

提供第2種刪除列方式，請測試看看，謝謝

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

samwang

回復 9# PJChen

請測試看看，謝謝

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

samwang

回復 9# PJChen


不好意思，請教一下您既然要用VBA為什麼還在Excel寫公式?
後學覺得用VBA在excel寫公式怪怪的，
直接在excel寫入公式，這樣不就好了嗎?

samwang

回復 3# PJChen


同一個檔案
C欄"供應商"分為大 & 美
從第3列開始,C欄<>美,則整列刪除
這是要單獨的程式....
>> 請問#7、#8可以用嗎?

samwang

回復 15# PJChen

#10
  .Formula = "=YEAR(B3) & "".."" & MONTH(B3)"
這段程式,無法截取B欄資料,將YYYY..M填入A欄
>> With [a3].Resize(R - 2)
    .Formula = "=YEAR(B3) & "".."" & MONTH(B3)"
    End With
    .Value = .Value '轉為值
這功能正常，這是將B欄資料沒經過條件轉為 "2021..6 "
如過您的需求是要經過日期比較，請自行將 .Cells(i, "a").Formula = "=YEAR(RC[1]) & "".."" & MONTH(RC[1])"
移到if 底下
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
請在測試看看，謝謝

samwang

回復 15# PJChen

#10
  .Formula = "=YEAR(B3) & "".."" & MONTH(B3)"
這段程式,無法截取B欄資料,將YYYY..M填入A欄
>> With [a3].Resize(R - 2)
    .Formula = "=YEAR(B3) & "".."" & MONTH(B3)"
    End With
    .Value = .Value '轉為值
這功能正常，這是將B欄資料沒經過條件轉為 "2021..6 "

如過您的需求是要經過日期比較，請自行將 .Cells(i, "a").Formula = "=YEAR(RC[1]) & "".."" & MONTH(RC[1])"
移到if 底下如下
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
請在測試看看，謝謝

samwang

回復 18# PJChen

E欄要填入單號(連結)T&S&R
但R欄=""時,則E欄="無交貨"
請問要如何改這段程式?
>> 依據您的程式做修改如下
        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

但是依據您的描述，後學覺得條件可以拆成2段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