返回列表 上一主題 發帖

請問一個排序轉置（VBA）的問題

tonycho33

帖子
102 
主題
30 
精華
0 
積分
137 
點名
0  
作業系統
winxp 
軟體版本
12 
閱讀權限
20 
性別
男 
註冊時間
2011-11-24 
最後登錄
2018-12-6 
1# 跳轉到 » 正序看帖
打印
tT
發表於 2011-12-6 12:02 | 只看該作者

請問一個排序轉置（VBA）的問題

1.從資料檔(a1~a6)轉置成輸出檔(c1~c6)
2.例如輸出檔從c1對應a1時，回去尋找資料檔對應欄位等於a1b1，再對應資料庫的值12，然後顯示於K7欄
3.在I欄統計各列值的總和

轉置排序.rar (2.79 KB)

收藏 分享

register313
　頭銜: 麻辣 路人甲

大學生Rank: 4

帖子
967 
主題
0 
精華
0 
積分
1001 
點名
0  
作業系統
WIN XP 
軟體版本
OFFICE 2003 
閱讀權限
50 
性別
男 
來自
台北 
註冊時間
2010-11-29 
最後登錄
2022-5-17 

2012龍年全勤獎章熱烈參與勳章
4#
發表於 2011-12-11 22:30 | 只看該作者
本帖最後由 register313 於 2011-12-11 22:50 編輯

回復 3# tonycho33


    有註解的4個儲存格 回傳值不知是否正確
  1. Sub zz()
  2. Sheets("Sheet1").Select
  3. Range("K6:AH17").ClearContents
  4. For I = 6 To 16 Step 2
  5.   W = 11
  6.   For J = 6 To 16 Step 2
  7.     For K = 4 To 7
  8.       If Cells(I, 10) = Cells(J + 1, K) Then
  9.          Cells(I, W) = Cells(J, 3)
  10.          S = Cells(J, 3) & Cells(J, K)
  11.          For T = 22 To 47
  12.            If S = Cells(T, 8) Then
  13.               Cells(I + 1, W) = Cells(T, 9)
  14.               W = W + 1
  15.               GoTo 123
  16.            End If
  17.          Next T
  18.          If Cells(I + 1, W) = "" Then
  19.             Cells(I + 1, W) = 0
  20.             W = W + 1
  21.          End If
  22.       End If
  23. 123:
  24.      Next K
  25.   Next J
  26. Next I
  27. End Sub
複製代碼

轉置排序1.zip (9.82 KB)

TOP

tonycho33

帖子
102 
主題
30 
精華
0 
積分
137 
點名
0  
作業系統
winxp 
軟體版本
12 
閱讀權限
20 
性別
男 
註冊時間
2011-11-24 
最後登錄
2018-12-6 
3#
發表於 2011-12-11 21:23 | 只看該作者
回復 2# register313


    請問之前參考您的程式，發現好像如果出現重複就無法排，要如何處理呢？
1.請問如果要從資料檔中 ，先從a1（c1,c1,c1,c1）順序下來，再來排a2帶入輸出檔
2.重複的也可排
3.vlookup如果抓不到值，可以帶入0嗎

轉置排序.rar (8.4 KB)

Tony

TOP

register313
　頭銜: 麻辣 路人甲

大學生Rank: 4

帖子
967 
主題
0 
精華
0 
積分
1001 
點名
0  
作業系統
WIN XP 
軟體版本
OFFICE 2003 
閱讀權限
50 
性別
男 
來自
台北 
註冊時間
2010-11-29 
最後登錄
2022-5-17 

2012龍年全勤獎章熱烈參與勳章
2#
發表於 2011-12-6 23:02 | 只看該作者
本帖最後由 register313 於 2011-12-6 23:06 編輯

回復 1# tonycho33
  
初學者VBA
  1. Sub zz()

  3. Sheets("Sheet1").Select
  4. Range("K6:Q17").ClearContents
  5.    
  6. For I = 6 To 16 Step 2
  7.   W = 11
  8.   For J = 6 To 16 Step 2
  9.     For K = 4 To 7
  10.       If Cells(I, 10) = Cells(J + 1, K) Then
  11.          Cells(I, W) = Cells(J, 3)
  12.          S = Cells(J, 3) & Cells(J, K)
  13.          Cells(I + 1, W) = WorksheetFunction.VLookup(S, Range("H22:I47"), 2, 0)
  14.          W = W + 1
  15.          GoTo 123
  16.       End If
  17.     Next K
  18. 123:
  19.   Next J
  20. Next I

  22. End Sub
複製代碼

TOP

        靜思自在 : 要用心，不要操心、煩心。
返回列表 上一主題