請測試看看,謝謝
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
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
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樓原始碼產生…
再依所需條件…...排序 失敗先 成功在後…另存一工作表(排序後)
請測試看看,謝謝
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
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
請問已下該如何修正?依所需條件 失敗 成功 重新排序
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
如上檔案今要刪除 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
回復 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