- 帖子
- 1446
- 主題
- 40
- 精華
- 0
- 積分
- 1470
- 點名
- 0
- 作業系統
- Windows 7
- 軟體版本
- Excel 2010 & 2016
- 閱讀權限
- 50
- 性別
- 男
- 來自
- 台灣
- 註冊時間
- 2020-7-15
- 最後登錄
- 2024-11-28
|
4#
發表於 2022-9-13 09:04
| 只看該作者
回復 2# dou10801
謝謝前輩發表此帖
後輩有兩種看法
1.保留原換行內容>表2 D欄儲存格格式設為不換行
Sub D欄儲存格格式設為不換行()
Arr = Sheets("工作表1").Range("A1:E" & Sheets("工作表1").Cells(Rows.Count, 1).End(xlUp).Row)
ReDim brr(1 To Sheets("工作表1").Cells(Rows.Count, 1).End(xlUp).Row, 1 To 5)
MS1 = 1
For i = 1 To UBound(Arr)
If Arr(i, 1) = "女" Then
brr(MS1, 1) = Arr(i, 1)
brr(MS1, 2) = Arr(i, 2)
brr(MS1, 3) = Arr(i, 3)
brr(MS1, 4) = Arr(i, 4)
brr(MS1, 5) = Arr(i, 5)
MS1 = MS1 + 1
End If
Next
Sheets("工作表2").Range("A1:E1000") = ""
Sheets("工作表2").Range("A1:E" & UBound(brr)) = brr
Sheets("工作表2").[D:D].WrapText = False
Sheets("工作表2").[D:D].Columns.AutoFit
End Sub
2.用取代的方式將換行字元轉換為空白字元
Option Explicit
Sub 符合條件_儲存格_換行轉換空白字元()
Dim Arr, i, x, MS1
Arr = Sheets("工作表1").[A1].CurrentRegion
MS1 = 0
For i = 1 To UBound(Arr)
If Arr(i, 1) = "女" Then
MS1 = MS1 + 1
For x = 1 To 5
Arr(MS1, x) = Replace(Arr(i, x), vbLf, " ")
Next
End If
Next
With Sheets("工作表2")
.[A:E].ClearContents
.[A1].Resize(MS1, 5) = Arr
.[D:D].Columns.AutoFit
End With
End Sub |
|
