- 帖子
- 522
- 主題
- 36
- 精華
- 1
- 積分
- 603
- 點名
- 0
- 作業系統
- win xp sp3
- 軟體版本
- Office 2003
- 閱讀權限
- 50
- 性別
- 男
- 註冊時間
- 2012-12-13
- 最後登錄
- 2021-7-11
|
2#
發表於 2014-3-29 13:15
| 只看該作者
回復 1# hamj3113
大大你好, 太晚了吧!!
試試看:
Sheet1 CommandButton1 之 VBA code:- '
- Option Explicit
- Private Sub CommandButton1_Click()
- Dim sh1, sh2 As Worksheet
- Dim i, cnt, oldK, newK, blankRow As Integer
- Dim 商品ABC, 商品部門, 商品名稱 As String
- Set sh1 = Sheets("Sheet1")
- Set sh2 = Sheets("Sheet2")
-
- 按_商品部門_商品ABC_排
-
- '取得目前資料筆數
- blankRow = [A65536].End(xlUp).Row
- i = 5
- Do
- oldK = sh2.[IV4].End(xlToLeft).Column + 1
- 商品部門 = sh1.Cells(i, 6)
- Do
- newK = oldK
- 商品ABC = sh1.Cells(i, 5)
-
- '本 VBA 只有在 商品ABC 均為 "A","B","C",...時, 才能正常運作
- '利用 "A","B","C" 的 ASCII 定位 商品名稱 的列位
- cnt = Asc(sh1.Cells(i, 5)) - 60
- Do
- sh2.Cells(4, newK) = 商品部門
- 商品名稱 = sh1.Cells(i, 3)
- sh2.Cells(cnt, newK) = 商品名稱
- newK = newK + 1
- i = i + 1
- If sh1.Cells(i, 5) = "" Then GoTo Done1
- Loop Until 商品ABC <> sh1.Cells(i, 5) Or 商品部門 <> sh1.Cells(i, 6)
-
- Loop Until 商品部門 <> sh1.Cells(i, 6)
-
- Loop Until 商品部門 = ""
-
- Done1:
- 'sh1 恢復原狀
- 按_排序_排
- End Sub
- Sub 按_排序_排()
- Dim sh1 As Worksheet
- Dim blankRow As Integer
- Set sh1 = Sheets("Sheet1")
-
- '取得目前資料筆數
- blankRow = sh1.[A65536].End(xlUp).Row
-
- sh1.[A4].Resize(blankRow, 7).Sort _
- Key1:=sh1.[A4], Order1:=xlAscending, _
- Header:=xlYes
- End Sub
- Sub 按_商品部門_商品ABC_排()
- Dim sh1 As Worksheet
- Dim blankRow As Integer
- Set sh1 = Sheets("Sheet1")
-
- '取得目前資料筆數
- blankRow = sh1.[A65536].End(xlUp).Row
-
- sh1.[A4].Resize(blankRow - 3, 7).Sort _
- Key1:=sh1.[F4], Order1:=xlAscending, _
- Key2:=sh1.[E4], Order2:=xlAscending, _
- Header:=xlYes
- End Sub
 |
|
發表於 2014-4-1 20:52
| 