Qin

帖子: 207
主題: 61
精華: 0
積分: 270
點名: 0
作業系統: Vista
軟體版本: office2003
閱讀權限: 20
性別: 女
註冊時間: 2011-3-20
最後登錄: 2023-6-25

1^# 跳轉到 » 正序看帖

打印

字體大小: tT

發表於 2011-3-27 12:02 | 只看該作者

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

Text.zip (41.5 KB)

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

樓主熱帖

Hsieh

超級版主 Rank: 8 Rank: 8

帖子: 4901
主題: 44
精華: 24
積分: 4916
點名: 254
作業系統: Windows 7
軟體版本: Office 20xx
閱讀權限: 150
性別: 男
來自: 台北
註冊時間: 2010-4-30
最後登錄: 2024-11-23

2023年全勤獎章 2022虎年全勤獎章 2021牛年全勤獎章 2020鼠年全勤獎章 2019 豬年全勤獎章 2018 狗年全勤獎章 2017 雞年全勤獎章 2016猴年全勤獎章 2015羊年全勤獎章 2014馬年全勤獎章 2013蛇年全勤獎章 2012龍年全勤獎章論壇貢獻勳章熱心公益勳章 2011兔年全勤獎章

7^#

發表於 2011-3-27 23:03 | 只看該作者

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

學海無涯_不恥下問

TOP

Hsieh

超級版主 Rank: 8 Rank: 8

帖子: 4901
主題: 44
精華: 24
積分: 4916
點名: 254
作業系統: Windows 7
軟體版本: Office 20xx
閱讀權限: 150
性別: 男
來自: 台北
註冊時間: 2010-4-30
最後登錄: 2024-11-23

2023年全勤獎章 2022虎年全勤獎章 2021牛年全勤獎章 2020鼠年全勤獎章 2019 豬年全勤獎章 2018 狗年全勤獎章 2017 雞年全勤獎章 2016猴年全勤獎章 2015羊年全勤獎章 2014馬年全勤獎章 2013蛇年全勤獎章 2012龍年全勤獎章論壇貢獻勳章熱心公益勳章 2011兔年全勤獎章

6^#

發表於 2011-3-27 22:41 | 只看該作者

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

學海無涯_不恥下問

TOP

GBKEE

超級版主 Rank: 8 Rank: 8

帖子: 5923
主題: 13
精華: 1
積分: 5986
點名: 0
作業系統: win10
軟體版本: Office 2010
閱讀權限: 150
性別: 男
來自: 台灣基隆
註冊時間: 2010-5-1
最後登錄: 2022-1-23

2017 雞年全勤獎章 2016猴年全勤獎章 2015羊年全勤獎章 2014馬年全勤獎章 2013蛇年全勤獎章 2012龍年全勤獎章論壇貢獻勳章熱烈參與勳章 2011兔年全勤獎章

5^#

發表於 2011-3-27 17:12 | 只看該作者

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

TOP

Qin

中學生 Rank: 2

帖子: 207
主題: 61
精華: 0
積分: 270
點名: 0
作業系統: Vista
軟體版本: office2003
閱讀權限: 20
性別: 女
註冊時間: 2011-3-20
最後登錄: 2023-6-25

4^#

發表於 2011-3-27 16:51 | 只看該作者

回復 3# Hsieh

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

TOP

Hsieh

超級版主 Rank: 8 Rank: 8

帖子: 4901
主題: 44
精華: 24
積分: 4916
點名: 254
作業系統: Windows 7
軟體版本: Office 20xx
閱讀權限: 150
性別: 男
來自: 台北
註冊時間: 2010-4-30
最後登錄: 2024-11-23

2023年全勤獎章 2022虎年全勤獎章 2021牛年全勤獎章 2020鼠年全勤獎章 2019 豬年全勤獎章 2018 狗年全勤獎章 2017 雞年全勤獎章 2016猴年全勤獎章 2015羊年全勤獎章 2014馬年全勤獎章 2013蛇年全勤獎章 2012龍年全勤獎章論壇貢獻勳章熱心公益勳章 2011兔年全勤獎章

3^#

發表於 2011-3-27 16:04 | 只看該作者

我覺得是這樣排列

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

複製代碼

學海無涯_不恥下問

TOP

FAlonso

中學生 Rank: 2

帖子: 135
主題: 19
精華: 0
積分: 165
點名: 0
作業系統: XP
軟體版本: 2003
閱讀權限: 20
性別: 男
來自: 香港
註冊時間: 2010-12-9
最後登錄: 2012-8-27

2^#

發表於 2011-3-27 13:46 | 只看該作者

Sub test()
Dim i As Integer, j As Integer, k As Integer, ar(), dic As Object
[j1:k65536] = ""
For i = 1 To [IV1].End(xlToLeft).Column Step 2
For j = 1 To [a65536].End(xlUp).Row Step 30
ar = Range(Cells(j, i), Cells(j + 29, i + 1))
For k = 1 To UBound(ar)
If Not ar(k, 1) Like "*部" Then
ar(k, 1) = Left(ar(k, 1), 1)
End If
Next
If [j65536].End(xlUp).Address = "$J$1" Then
[j65536].End(xlUp).Resize(UBound(ar), 2) = Application.Transpose(Application.Transpose(ar))
Else
[j65536].End(xlUp).Offset(1).Resize(UBound(ar), 2) = Application.Transpose(Application.Transpose(ar))
Erase ar
End If
Next
Next
End Sub

複製代碼

試試這個

80 字節以內
不支持自定義 Discuz! 代碼

TOP