[發問] 求助EXCEL神人 能否解決這對應表格帶入問題

hamj3113

以下為2個工作表

表一為資料:

下載 (99.19 KB)

2014-3-18 18:55

希望能把表一用公式帶入表二:

下載 (21.8 KB)

2014-3-18 19:01

最後變成:

下載 (36.38 KB)

2014-3-18 19:00

請問各位神人這樣是否有辦法可以用公式帶入呢?

hamj3113

回復 2# yen956


    感謝大大的幫忙^^

ML089

回復 1# hamj3113

請提供檔案 ... 比較方便TEST

yen956

回復 1# hamj3113
大大你好, 太晚了吧!!
試試看:
Sheet1 CommandButton1 之 VBA code:

1. '
   
2. Option Explicit
   
3. Private Sub CommandButton1_Click()
   
4.     Dim sh1, sh2 As Worksheet
   
5.     Dim i, cnt, oldK, newK, blankRow As Integer
   
6.     Dim 商品ABC, 商品部門, 商品名稱 As String
   
7.     Set sh1 = Sheets("Sheet1")
   
8.     Set sh2 = Sheets("Sheet2")
   
9.    
   
10.     按_商品部門_商品ABC_排
    
11.    
    
12.     '取得目前資料筆數
    
13.     blankRow = [A65536].End(xlUp).Row
    
14.     i = 5
    
15.     Do
    
16.         oldK = sh2.[IV4].End(xlToLeft).Column + 1
    
17.         商品部門 = sh1.Cells(i, 6)
    
18.         Do
    
19.             newK = oldK
    
20.             商品ABC = sh1.Cells(i, 5)
    
21.         
    
22.             '本 VBA 只有在 商品ABC 均為 "A","B","C",...時, 才能正常運作
    
23.             '利用 "A","B","C" 的 ASCII 定位 商品名稱 的列位
    
24.             cnt = Asc(sh1.Cells(i, 5)) - 60
    
25.             Do
    
26.                 sh2.Cells(4, newK) = 商品部門
    
27.                 商品名稱 = sh1.Cells(i, 3)
    
28.                 sh2.Cells(cnt, newK) = 商品名稱
    
29.                 newK = newK + 1
    
30.                 i = i + 1
    
31.                 If sh1.Cells(i, 5) = "" Then GoTo Done1
    
32.             Loop Until 商品ABC <> sh1.Cells(i, 5) Or 商品部門 <> sh1.Cells(i, 6)
    
33.             
    
34.         Loop Until 商品部門 <> sh1.Cells(i, 6)
    
35.         
    
36.     Loop Until 商品部門 = ""
    
37.    
    
38. Done1:
    
39.     'sh1 恢復原狀
    
40.     按_排序_排
    
41. End Sub

複製代碼

Module1 之 VBA code

1. Sub 按_排序_排()
   
2.     Dim sh1 As Worksheet
   
3.     Dim blankRow As Integer
   
4.     Set sh1 = Sheets("Sheet1")
   
5.    
   
6.     '取得目前資料筆數
   
7.     blankRow = sh1.[A65536].End(xlUp).Row
   
8.    
   
9.     sh1.[A4].Resize(blankRow, 7).Sort _
   
10.               Key1:=sh1.[A4], Order1:=xlAscending, _
    
11.               Header:=xlYes
    
12. End Sub
    
13. 
    
14. Sub 按_商品部門_商品ABC_排()
    
15.     Dim sh1 As Worksheet
    
16.     Dim blankRow As Integer
    
17.     Set sh1 = Sheets("Sheet1")
    
18.    
    
19.     '取得目前資料筆數
    
20.     blankRow = sh1.[A65536].End(xlUp).Row
    
21.    
    
22.     sh1.[A4].Resize(blankRow - 3, 7).Sort _
    
23.               Key1:=sh1.[F4], Order1:=xlAscending, _
    
24.               Key2:=sh1.[E4], Order2:=xlAscending, _
    
25.               Header:=xlYes
    
26. End Sub

複製代碼