麻辣家族討論版版 - Powered by Discuz! Board

標題: [發問] 依所需條件失敗成功重新排序... [打印本頁]

作者: cypd 時間: 2021-11-6 23:15 標題: 依所需條件失敗成功重新排序...

該如何將原始檔...資料筆數不固定(不以資料篩選手動方式複製貼上)
[attach]34353[/attach]
希望結果是依照原始檔 I 欄內回覆按所需條件
失敗(代碼 1 )全部先排序之後，
再排序成功(代碼 0 )之方式，
另存一個新的完整工作表(檔名為-排序後)

[attach]34354[/attach]

[attach]34355[/attach]

作者: 准提部林 時間: 2021-11-7 08:46

1) 手動增建工作表:排序表
2) 原表→全選→複製
3) 排序表→全選→貼上, 複製→貼上值
選取h2→遞減排序
4) 工作表→移動或複製→勾選"建立副本"→至"新活頁簿"→另存新檔→重新命名→儲存

熟練的話, 不須一分鐘吧!

作者: hcm19522 時間: 2021-11-7 10:04

https://blog.xuite.net/hcm19522/twblog/590109463

作者: cypd 時間: 2021-11-7 16:41

回復 2# 准提部林

感謝版主准提部林不吝指導

希望結果是能將近千筆的數據輸入或貼上相關數據之後
新工作表就能呈現所需結果(應該是指預設公式或是以VBA...進行排序)

作者: cypd 時間: 2021-11-7 16:45

回復 3# hcm19522

感恩 hcm19522 ...依所示陣列公式

已成功按所需條件...排序失敗先成功在後 ^^

作者: samwang 時間: 2021-11-8 16:21

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

作者: cypd 時間: 2021-11-9 03:32

回復 6# samwang

非常感謝 samwang 的回覆
已測試完成!希望結果正是我所需求的 ^^

另外有一問題
希望將工作表1內 E欄全部扣帳數據及 G 欄費用全部數據(筆數資料不固定)
希望用 VBA 程式碼方式將此二欄的數據全部複製到轉換資料工作表 A欄(扣帳) B欄(費用)之相關欄位內…

[attach]34360[/attach]

[attach]34361[/attach]

作者: samwang 時間: 2021-11-9 07:56

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

作者: cypd 時間: 2021-11-9 12:45

回復 8# samwang

水啦!!真的非常感謝 samwang 的回覆 ^^

針對 samwang 6樓以下原始的回覆

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

※若 I 欄回覆欄位成功與失敗(=IF(H3="","",IF(H3=0,"成功","失敗"))
系依據 H 欄內代碼 0 與 1 (成功-0 ,失敗-1)所產生
麻請 samwang 是否能將6樓原始碼修正，將 I 欄回覆欄位成功與失敗函數公式(=IF(H3="","",IF(H3=0,"成功","失敗"))，以 VBA 方式加入6樓原始碼產生…
再依所需條件…...排序失敗先成功在後…另存一工作表(排序後)

[attach]34362[/attach]

作者: samwang 時間: 2021-11-9 14:57

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

作者: cypd 時間: 2021-11-10 14:07

回復 10# samwang

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

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

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

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

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

作者: samwang 時間: 2021-11-10 14:25

回復 11# cypd

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

作者: cypd 時間: 2021-11-11 21:00

回復 12# samwang

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

[attach]34370[/attach]

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

[attach]34371[/attach]

作者: samwang 時間: 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

作者: cypd 時間: 2021-11-12 12:29

回復 14# samwang

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

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

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

作者: cypd 時間: 2022-9-27 14:12

回復 14# samwang

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

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

[attach]35240[/attach]

請問已下該如何修正?依所需條件失敗成功重新排序
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

[attach]35241[/attach]

作者: samwang 時間: 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 時間: 2022-9-27 16:09

回復 17# samwang

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

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

作者: samwang 時間: 2022-9-27 17:36

回復 samwang

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

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

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

作者: cypd 時間: 2022-9-27 22:31

回復 19# samwang

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

[attach]35242[/attach]

作者: samwang 時間: 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 時間: 2022-9-28 12:56

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

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