請問自動換行格式要如何拆分兩行 公式及VBA做法?
- 帖子
- 71
- 主題
- 10
- 精華
- 0
- 積分
- 85
- 點名
- 0
- 作業系統
- win
- 軟體版本
- 7
- 閱讀權限
- 20
- 性別
- 女
- 註冊時間
- 2024-2-3
- 最後登錄
- 2025-3-28
|
請問自動換行格式要如何拆分兩行 公式及VBA做法?
請問自動換行格式要如何拆分兩行 公式及VBA做法?
如何把A1欄第一排放B1欄其資料放C1 |
|
|
|
|
|
|
- 帖子
- 1447
- 主題
- 40
- 精華
- 0
- 積分
- 1471
- 點名
- 0
- 作業系統
- Windows 7
- 軟體版本
- Excel 2010 & 2016
- 閱讀權限
- 50
- 性別
- 男
- 來自
- 台灣
- 註冊時間
- 2020-7-15
- 最後登錄
- 2025-5-5
|
2#
發表於 2024-2-26 09:05
| 只看該作者
回復 1# aassddff736
"整理"表 執行前:
"整理"表 執行結果:
Option Explicit
Sub 排成表彙整為整理表()
Dim Brr, Crr, i&, R&, xU As Range, xS As Worksheet
Set xS = Sheets("排成")
[整理!A1].CurrentRegion.Offset(1).EntireRow.Delete
Brr = Range(xS.[D2], xS.[A65536])
ReDim Crr(1 To UBound(Brr), 1 To 6)
For i = 1 To UBound(Brr)
If Trim(Brr(i, 2)) = "" Then GoTo i01 Else R = R + 1
If InStr(Brr(i, 3), vbLf) Then
If xU Is Nothing Then
Set xU = Sheets("整理").Cells(R + 1, 6)
Else
Set xU = Union(xU, Sheets("整理").Cells(R + 1, 6))
End If
End If
Crr(R, 1) = R
Crr(R, 2) = Trim(Brr(i, 1))
Crr(R, 3) = Trim(Brr(i, 2))
Crr(R, 4) = Trim(Split(Brr(i, 3) & vbLf, vbLf)(0))
Crr(R, 5) = Val(Brr(i, 4))
Crr(R, 6) = Mid(Trim(Brr(i, 3)), InStr(Trim(Brr(i, 3)), vbLf) + 1)
i01: Next
If R = 0 Then MsgBox "沒有資料": Exit Sub
With [整理!A2].Resize(R, 6)
.Value = Crr
.Borders.LineStyle = xlContinuous
End With
If Not xU Is Nothing Then xU.Font.ColorIndex = 3
End Sub |
|
用行動裝置瀏覽論壇學習很方便,謝謝論壇經營團隊
請大家一起上論壇來交流
|
|
|
|
|
- 帖子
- 71
- 主題
- 10
- 精華
- 0
- 積分
- 85
- 點名
- 0
- 作業系統
- win
- 軟體版本
- 7
- 閱讀權限
- 20
- 性別
- 女
- 註冊時間
- 2024-2-3
- 最後登錄
- 2025-3-28
|
3#
發表於 2024-2-26 11:35
| 只看該作者
|
|
|
|
|
|
- 帖子
- 71
- 主題
- 10
- 精華
- 0
- 積分
- 85
- 點名
- 0
- 作業系統
- win
- 軟體版本
- 7
- 閱讀權限
- 20
- 性別
- 女
- 註冊時間
- 2024-2-3
- 最後登錄
- 2025-3-28
|
4#
發表於 2024-2-26 12:51
| 只看該作者
回復 2# Andy2483
請教一下~
1.F欄黑色字體想變成空白如何做?
檢驗記錄表-A4--test.zip (33.95 KB)
2.我想增加資料項目如更改?
3.我想一次性列印 怎麼把資料帶進SHEET("記錄表")內 |
|
|
|
|
|
|
- 帖子
- 1447
- 主題
- 40
- 精華
- 0
- 積分
- 1471
- 點名
- 0
- 作業系統
- Windows 7
- 軟體版本
- Excel 2010 & 2016
- 閱讀權限
- 50
- 性別
- 男
- 來自
- 台灣
- 註冊時間
- 2020-7-15
- 最後登錄
- 2025-5-5
|
5#
發表於 2024-2-26 13:49
| 只看該作者
回復 Andy2483
真的很感謝您
aassddff736 發表於 2024-2-26 11:35 
Option Explicit
Sub 排成表彙整為整理表()
Dim Brr, Crr, i&, R&, xU As Range, xS As Worksheet
Set xS = Sheets("排程")
'↑令xS變數是 "排程"工作表
[整理!A1].CurrentRegion.Offset(1).EntireRow.Delete
'↑令"整理"表留下標題列,其它列刪除
Brr = Range(xS.[D2], xS.[A65536])
'↑令Brr變數是二維陣列,以儲存格值帶入陣列中
ReDim Crr(1 To UBound(Brr), 1 To 6)
'↑宣告Crr變數是二維空陣列,宣告上下 左右範圍
For i = 1 To UBound(Brr)
'↑設順迴圈!i從1到 Brr陣列最大索引列號
If Trim(Brr(i, 2)) = "" Then GoTo i01 Else R = R + 1
'↑如果關鍵欄空格就略過,否則就令R變數累加1
Crr(R, 1) = R
Crr(R, 2) = Trim(Brr(i, 1))
Crr(R, 3) = Trim(Brr(i, 2))
Crr(R, 4) = Trim(Split(Brr(i, 3) & vbLf, vbLf)(0))
Crr(R, 5) = Val(Brr(i, 4))
Crr(R, 6) = Mid(Trim(Brr(i, 3)), InStr(Trim(Brr(i, 3)), vbLf) + 1)
'↑將Brr陣列值寫入Crr陣列中
i01: Next
If R = 0 Then MsgBox "沒有資料": Exit Sub
With [整理!A2].Resize(R, 6)
.Value = Crr
'↑將Crr陣列值寫入儲存格中
.Borders.LineStyle = xlContinuous
'↑設定格線
End With
End Sub |
|
用行動裝置瀏覽論壇學習很方便,謝謝論壇經營團隊
請大家一起上論壇來交流
|
|
|
|
|
- 帖子
- 1410
- 主題
- 4
- 精華
- 0
- 積分
- 1420
- 點名
- 0
- 作業系統
- WIN
- 軟體版本
- 2007
- 閱讀權限
- 50
- 性別
- 男
- 註冊時間
- 2015-9-11
- 最後登錄
- 2025-5-16

|
6#
發表於 2024-2-26 14:51
| 只看該作者
|
google"EXCEL迷" blog 或google網址:https://hcm19522.blogspot.com/
|
|
|
|
|
- 帖子
- 71
- 主題
- 10
- 精華
- 0
- 積分
- 85
- 點名
- 0
- 作業系統
- win
- 軟體版本
- 7
- 閱讀權限
- 20
- 性別
- 女
- 註冊時間
- 2024-2-3
- 最後登錄
- 2025-3-28
|
7#
發表於 2024-2-27 22:05
| 只看該作者
回復 6# hcm19522
大神求助
我試著修改有以下兩個問題
[
test2.rar (36.36 KB)
]37516[/attachimg]
1."記錄表"我這樣帶似乎跑太慢,跟不上 列印速度
2.黃色螢光筆部分有想更簡潔方式嗎? |
-
-
擷取.JPG
(31.92 KB)
|
|
|
|
|
|