[發問] 依所需條件 失敗 成功 重新排序...

帖子: 248
主題: 42
精華: 0
積分: 322
點名: 11
作業系統: XP
軟體版本: Office2007
閱讀權限: 20
註冊時間: 2015-2-20
最後登錄: 2026-9-15

22^#

發表於 2022-9-28 12:56 | 只看該作者

回復 21# samwang
非常感謝 samwang 不吝指教
所述問題已知相關欄位之修正後
產生所需失敗成功之排序已處OK!
感嗯 ^^

帖子: 976
主題: 7
精華: 0
積分: 1018
點名: 0
作業系統: Win10
軟體版本: Office 2016
閱讀權限: 50
性別: 男
註冊時間: 2013-4-19
最後登錄: 2026-5-26

21^#

發表於 2022-9-28 07:36 | 只看該作者

回復 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

cypd

帖子: 248
主題: 42
精華: 0
積分: 322
點名: 11
作業系統: XP
軟體版本: Office2007
閱讀權限: 20
註冊時間: 2015-2-20
最後登錄: 2026-9-15

20^#

發表於 2022-9-27 22:31 | 只看該作者

回復 19# samwang

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

1110927-1.rar (40.75 KB)

帖子: 976
主題: 7
精華: 0
積分: 1018
點名: 0
作業系統: Win10
軟體版本: Office 2016
閱讀權限: 50
性別: 男
註冊時間: 2013-4-19
最後登錄: 2026-5-26

19^#

發表於 2022-9-27 17:36 | 只看該作者

回復 samwang

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

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

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

cypd

帖子: 248
主題: 42
精華: 0
積分: 322
點名: 11
作業系統: XP
軟體版本: Office2007
閱讀權限: 20
註冊時間: 2015-2-20
最後登錄: 2026-9-15

18^#

發表於 2022-9-27 16:09 | 只看該作者

回復 17# samwang

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

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

帖子: 976
主題: 7
精華: 0
積分: 1018
點名: 0
作業系統: Win10
軟體版本: Office 2016
閱讀權限: 50
性別: 男
註冊時間: 2013-4-19
最後登錄: 2026-5-26

17^#

發表於 2022-9-27 15:54 | 只看該作者

回復 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

帖子: 248
主題: 42
精華: 0
積分: 322
點名: 11
作業系統: XP
軟體版本: Office2007
閱讀權限: 20
註冊時間: 2015-2-20
最後登錄: 2026-9-15

16^#

發表於 2022-9-27 14:12 | 只看該作者

回復 14# samwang

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

今有一問題請問
如上檔案今要刪除 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, 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)

cypd

帖子: 248
主題: 42
精華: 0
積分: 322
點名: 11
作業系統: XP
軟體版本: Office2007
閱讀權限: 20
註冊時間: 2015-2-20
最後登錄: 2026-9-15

15^#

發表於 2021-11-12 12:29 | 只看該作者

回復 14# samwang

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

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

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

帖子: 976
主題: 7
精華: 0
積分: 1018
點名: 0
作業系統: Win10
軟體版本: Office 2016
閱讀權限: 50
性別: 男
註冊時間: 2013-4-19
最後登錄: 2026-5-26

14^#

發表於 2021-11-12 07:49 | 只看該作者

回復 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