cypd

回復 10# samwang

讚啦!!  感恩 samwang  的回覆  ^^

針對所遇問題已逐一處理完善...

輸入數據或貼上數據之後執行該巨集順暢迅速

程式碼中  .Sort Key1:=.Item(9), Order2:=2, Header:=xlYes

...請問該段程式碼說明是指自訂排序?

samwang

回復 11# cypd

程式碼中  .Sort Key1:=.Item(9), Order2:=2, Header:=xlYes
...請問該段程式碼說明是指自訂排序?
>>是

cypd

回復 12# samwang

不好意思再度勞麻您
針對以下問題:

下載 (187.2 KB)

2021-11-11 20:58

希望結果不以函數公式呈現
以 VBA 程式碼呈現統計
H欄失敗(L3)成功(M3)區別人數及總人數(L4)
併計算 G欄和記總費用(L5)   ^^

1111.rar (45.31 KB)

下載次數: 2

2021-11-11 21:00

samwang

回復 13# cypd

希望結果不以函數公式呈現
以 VBA 程式碼呈現統計
H欄失敗(L3)成功(M3)區別人數及總人數(L4)
併計算 G欄和記總費用(L5)   ^^
>> 如下，請測試看看，謝謝

Sub test()
Dim Arr, i&, s%, f%, Cnt
With Sheets("工作表1")
    Arr = .Range(.[i3], .[a65536].End(3))
    For i = 1 To UBound(Arr)
        If Arr(i, 8) = 0 Then s = s + 1: Arr(i, 9) = "成功"
        If Arr(i, 8) = 1 Then f = f + 1: Arr(i, 9) = "失敗"
        Cnt = Cnt + Arr(i, 7)
    Next
    .[L3] = f: .[M3] = s: .[L4] = UBound(Arr): .[L5] = Cnt
    [a3].Resize(UBound(Arr), 9) = Arr
    .Copy After:=Sheets(Sheets.Count)
End With
With Range([a2], [i65536].End(3))
    .Sort Key1:=.Item(9), Order2:=2, Header:=xlYes
End With
End Sub

cypd

回復 14# samwang

非常之讚啦!!  感恩 samwang  熱心的回覆

經過巧手編織而成的 VBA 程式碼 +-*/運算自如

所提問之問題已完美處理完成...謝謝您   ^^

cypd

回復 14# samwang

感恩 samwang  熱心的回覆
經過巧手編織而成的 VBA 程式碼 +-*/運算自如

今有一問題請問
如上檔案今要刪除 C 欄1欄

下載 (74.3 KB)

2022-9-27 14:11

請問已下該如何修正?依所需條件 失敗 成功 重新排序
Sub test()
Dim Arr, i&, s%, f%, Cnt
With Sheets("工作表1")
    Arr = .Range(.[i3], .[a65536].End(3))
    For i = 1 To UBound(Arr)
        If Arr(i, 7) = 0 Then s = s + 1: Arr(i, 8) = "成功"
        If Arr(i, 7) = 1 Then f = f + 1: Arr(i, 8) = "失敗"
        Cnt = Cnt + Arr(i, 6)
    Next
    .[K3] = f: .[L3] = s: .[K4] = UBound(Arr): .[K5] = Cnt
    [a3].Resize(UBound(Arr), 9) = Arr
    .Copy After:=Sheets(Sheets.Count)
End With
With Range([a2], [i65536].End(3))
    .Sort Key1:=.Item(9), Order2:=2, Header:=xlYes
End With
End Sub

1110927.rar (46.3 KB)

下載次數: 2

2022-9-27 14:11

samwang

回復  samwang

感恩 samwang  熱心的回覆
經過巧手編織而成的 VBA 程式碼 +-*/運算自如

今有一問題 ...
cypd 發表於 2022-9-27 14:12

如上檔案今要刪除 C 欄1欄>>是這樣嗎?
Sub test()
Dim Arr, i&, s%, f%, Cnt
With Sheets("工作表1")
    Arr = .Range(.[i3], .[a65536].End(3))
    For i = 1 To UBound(Arr)
        If Arr(i, 8) = 0 Then s = s + 1: Arr(i, 9) = "成功"
        If Arr(i, 8) = 1 Then f = f + 1: Arr(i, 9) = "失敗"
        Cnt = Cnt + Arr(i, 7)
    Next
    .[L3] = f: .[M3] = s: .[L4] = UBound(Arr): .[L5] = Cnt
    [a3].Resize(UBound(Arr), 9) = Arr
    .Copy After:=Sheets(Sheets.Count)
End With
With Range([a2], [i65536].End(3))
    .Sort Key1:=.Item(9), Order2:=2, Header:=xlYes
End With
Columns("C:C").Delete Shift:=xlToLeft
End Sub

cypd

回復 17# samwang

非常感謝 samwang  熱心的回覆
(不好意思問題沒表達清楚)

問題是檔案中的 C 欄已刪除的情況下...(附件的檔案 C 欄尚未刪除)

samwang

回復  samwang

非常感謝 samwang  熱心的回覆
(不好意思問題沒表達清楚)

問題是檔案中的 C 欄已刪除 ...
cypd 發表於 2022-9-27 16:09

不好意思，有點無法理解您的需求，請再說明一下原來狀況/需求結果，謝謝

cypd

回復 19# samwang

感謝您@細心  ^^
依所需條件 失敗 成功 重新排序
檔案已附...

1110927-1.rar (40.75 KB)

下載次數: 2

2022-9-27 22:30