麻辣家族討論版版 - Powered by Discuz! Board

標題: [發問] 條件取值,字串會變二行,請前輩指點感恩. [打印本頁]

作者: dou10801 時間: 2022-9-12 10:29 標題: 條件取值,字串會變二行,請前輩指點感恩.

條件取值,d欄字串會變二行,可能有空一格,請前輩指點感恩.

作者: dou10801 時間: 2022-9-12 11:20

回復 1# dou10801 如何變成一行,謝謝.

作者: samwang 時間: 2022-9-12 16:21

回復 dou10801 如何變成一行,謝謝.
dou10801 發表於 2022-9-12 11:20

用你原來的程式碼修改如下，請測試看看，謝謝

Sub 按鈕1_Click()
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)
      a = Split(arr(i, 4), Chr(10))
      For j = 0 To UBound(a): brr(ms1, 4) = brr(ms1, 4) & a(j): Next
      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
End Sub

作者: Andy2483 時間: 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

作者: dou10801 時間: 2022-9-14 09:28

感謝兩位先進指導samwang,Andy2483,一個問題有三種方法,收下慢慢學習,感恩.

歡迎光臨麻辣家族討論版版 (http://forum.twbts.com/)