Board logo

標題: [發問] 求助EXCEL神人 能否解決這對應表格帶入問題 [打印本頁]
作者: hamj3113    時間: 2014-3-18 19:02     標題: 求助EXCEL神人 能否解決這對應表格帶入問題

以下為2個工作表

表一為資料:

[attach]17807[/attach]


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

[attach]17810[/attach]

最後變成:

[attach]17809[/attach]

請問各位神人這樣是否有辦法可以用公式帶入呢?
作者: yen956    時間: 2014-3-29 13:15

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

  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
複製代碼

作者: ML089    時間: 2014-4-1 20:52

回復 1# hamj3113

請提供檔案 ... 比較方便TEST
作者: hamj3113    時間: 2014-4-6 16:38

回復 2# yen956


    感謝大大的幫忙^^



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