samwang

回復 1# cypd

請測試看看，謝謝
Sub test()
Dim Arr
Sheets("工作表1").Copy After:=Sheets(Sheets.Count)
With Range([a2], [i65536].End(3))
    Arr = .Value
    .Value = Arr
    .Sort Key1:=.Item(9), Order2:=2, Header:=xlYes
End With
End Sub

samwang

回復 7# cypd

Sub test()
With Sheets("工作表1")
    R = .Range("e65536").End(3).Row
    .Range("e3:e" & R).Copy Sheets("轉換資料").[a2]
    .Range("g3:g" & R).Copy Sheets("轉換資料").[b2]
End With
End Sub

samwang

回復 9# cypd

請測試看看，謝謝
Sub test2()
Dim Arr, i&
With Sheets("工作表1")
    Arr = .Range(.[i3], .[a65536].End(3))
    For i = 1 To UBound(Arr)
        If Arr(i, 8) = 0 Then Arr(i, 9) = "成功"
        If Arr(i, 8) = 1 Then Arr(i, 9) = "失敗"
    Next
    [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

samwang

回復 11# cypd

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

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

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

samwang

回復  samwang

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

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

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

samwang

回復 20# cypd
請測試看看，謝謝
Sub test()
Dim Arr, i&, s%, f%, Cnt
With Sheets("工作表1")
    Arr = .Range(.[h3], .[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, 7)
    Next
    .[K3] = f: .[L3] = s: .[K4] = UBound(Arr): .[K5] = Cnt
    [a3].Resize(UBound(Arr), 8) = Arr
    .Copy After:=Sheets(Sheets.Count)
End With
With Range([a2], [h65536].End(3))
    .Sort Key1:=.Item(8), Order2:=2, Header:=xlYes
End With
End Sub