[發問] 條件取值,字串會變二行,請前輩指點感恩.

dou10801

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

dou10801

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

samwang

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

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

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