帖子: 152
主題: 45
精華: 0
積分: 239
點名: 272
作業系統: WIN10
軟體版本: 2010
閱讀權限: 20
性別: 男
來自: 台灣
註冊時間: 2011-6-21
最後登錄: 2025-10-31

2024年全勤獎章 2023年全勤獎章 2022虎年全勤獎章 2021牛年全勤獎章論壇榮譽勳章論壇贊助勳章

1^# 跳轉到 » 正序看帖

打印

字體大小: tT

發表於 2022-9-12 10:29 | 只看該作者

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

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

字串轉換.rar (18.06 KB)

樓主熱帖

杜小平

dou10801

中學生 Rank: 2

帖子: 152
主題: 45
精華: 0
積分: 239
點名: 272
作業系統: WIN10
軟體版本: 2010
閱讀權限: 20
性別: 男
來自: 台灣
註冊時間: 2011-6-21
最後登錄: 2025-10-31

2024年全勤獎章 2023年全勤獎章 2022虎年全勤獎章 2021牛年全勤獎章論壇榮譽勳章論壇贊助勳章

5^#

發表於 2022-9-14 09:28 | 只看該作者

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

杜小平

TOP

Andy2483

　暱稱: 厚臉皮的學生

碩士班 Rank: 5 Rank: 5

帖子: 1517
主題: 40
精華: 0
積分: 1541
點名: 0
作業系統: Windows 7
軟體版本: Excel 2010 & 2016
閱讀權限: 100
性別: 男
來自: 台灣
註冊時間: 2020-7-15
最後登錄: 2025-10-31

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

TOP

samwang

大學生 Rank: 4

帖子: 976
主題: 7
精華: 0
積分: 1018
點名: 0
作業系統: Win10
軟體版本: Office 2016
閱讀權限: 50
性別: 男
註冊時間: 2013-4-19
最後登錄: 2025-8-22

3^#

發表於 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

TOP

dou10801

中學生 Rank: 2

帖子: 152
主題: 45
精華: 0
積分: 239
點名: 272
作業系統: WIN10
軟體版本: 2010
閱讀權限: 20
性別: 男
來自: 台灣
註冊時間: 2011-6-21
最後登錄: 2025-10-31

2024年全勤獎章 2023年全勤獎章 2022虎年全勤獎章 2021牛年全勤獎章論壇榮譽勳章論壇贊助勳章

2^#

發表於 2022-9-12 11:20 | 只看該作者

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

杜小平

TOP