[發問] 如何將每列30行的單元格順序排列?

Qin

Text.zip (41.5 KB)

下載次數: 13

2011-3-27 11:57

疑問: 1) 如何將每頁的每30,行的單元格順痑排下去?
         2) 如何清除單元格內的多餘文字: 數字, 符號?

FAlonso

1. Sub test()
   
2. Dim i As Integer, j As Integer, k As Integer, ar(), dic As Object
   
3. 
   
4. [j1:k65536] = ""
   
5. 
   
6. For i = 1 To [IV1].End(xlToLeft).Column Step 2
   
7.     For j = 1 To [a65536].End(xlUp).Row Step 30
   
8.     ar = Range(Cells(j, i), Cells(j + 29, i + 1))
   
9.         For k = 1 To UBound(ar)
   
10.         If Not ar(k, 1) Like "*部" Then
    
11.         ar(k, 1) = Left(ar(k, 1), 1)
    
12.         End If
    
13.         Next
    
14. 
    
15. If [j65536].End(xlUp).Address = "$J$1" Then
    
16. [j65536].End(xlUp).Resize(UBound(ar), 2) = Application.Transpose(Application.Transpose(ar))
    
17. Else
    
18. [j65536].End(xlUp).Offset(1).Resize(UBound(ar), 2) = Application.Transpose(Application.Transpose(ar))
    
19. Erase ar
    
20. End If
    
21. 
    
22. Next
    
23. Next
    
24. 
    
25. End Sub

複製代碼

試試這個

Hsieh

我覺得是這樣排列

1. Sub ex()
   
2. Dim s%
   
3. [J:IV] = ""
   
4. Cells.Replace "(*)", ""
   
5. r = [a65536].End(xlUp).Row
   
6. For i = 1 To r Step 30
   
7.    For k = 1 To 7 Step 2
   
8.    ar = Cells(i, k).Resize(30, 2).Value
   
9.    h = IIf(k = 1, 1, IIf(k = 3, 31, IIf(k = 5, 61, 91)))
   
10.    Cells(h, 10 + s * 2).Resize(30, 2) = Application.Transpose(Application.Transpose(ar))
    
11.    Next
    
12.    s = s + 1
    
13. Next
    
14. End Sub

複製代碼

Qin

回復 3# Hsieh


版主您好!!
謝謝您的解答, 但我看不明白哦,
我又無法下載此檔案，
可否麻煩您將檔案寄給我
謝謝您!!
感激不盡

GBKEE

回復 4# Qin
按下 2樓 ,3樓  最底端 複製代碼  將程式碼 貼到excel檔案 的 VBA視窗 ,再按F5 執行程式

Hsieh

回復 4# Qin

既然是在一般區發問，同樣用函數解決看看
定義名稱
x=INT((ROW()-1)/30)
y=CHOOSE(x+1,1,3,5,7)
z=MOD(ROW()-1,30)+1+INT((COLUMN(!A$1)-1)/2)*30
J1公式
=INDIRECT("R"&z&"C"&y+MOD(COLUMN(A$1)+1,2),0)&""
向下複製到J120
J1:J120向右複製    Text.rar (98.3 KB)

下載次數: 4

2011-3-27 22:41

Hsieh

關於清除括號及數字如圖操作

下載 (272.76 KB)

2011-3-27 23:03