返回列表 上一主題 發帖

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

dou10801

帖子
140 
主題
39 
精華
0 
積分
221 
點名
105  
作業系統
WIN10 
軟體版本
2010 
閱讀權限
20 
性別
男 
來自
台灣 
註冊時間
2011-6-21 
最後登錄
2024-4-19 

2023年全勤獎章2022虎年全勤獎章2021牛年全勤獎章論壇榮譽勳章論壇贊助勳章
1# 跳轉到 » 倒序看帖
打印
tT
發表於 2022-9-12 10:29 | 只看該作者

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

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

字串轉換.rar (18.06 KB)

收藏 分享
杜小平

dou10801

帖子
140 
主題
39 
精華
0 
積分
221 
點名
105  
作業系統
WIN10 
軟體版本
2010 
閱讀權限
20 
性別
男 
來自
台灣 
註冊時間
2011-6-21 
最後登錄
2024-4-19 

2023年全勤獎章2022虎年全勤獎章2021牛年全勤獎章論壇榮譽勳章論壇贊助勳章
2#
發表於 2022-9-12 11:20 | 只看該作者
回復 1# dou10801 如何變成一行,謝謝.
杜小平

TOP

samwang

帖子
976 
主題
7 
精華
0 
積分
1018 
點名
0  
作業系統
Win10 
軟體版本
Office 2016 
閱讀權限
50 
性別
男 
註冊時間
2013-4-19 
最後登錄
2023-9-21 
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

Andy2483
　暱稱: 厚臉皮的學生

大學生Rank: 4

帖子
1425 
主題
40 
精華
0 
積分
1449 
點名
0  
作業系統
Windows 7 
軟體版本
Excel 2010 & 2016 
閱讀權限
50 
性別
男 
來自
台灣 
註冊時間
2020-7-15 
最後登錄
2024-4-16 
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

dou10801

帖子
140 
主題
39 
精華
0 
積分
221 
點名
105  
作業系統
WIN10 
軟體版本
2010 
閱讀權限
20 
性別
男 
來自
台灣 
註冊時間
2011-6-21 
最後登錄
2024-4-19 

2023年全勤獎章2022虎年全勤獎章2021牛年全勤獎章論壇榮譽勳章論壇贊助勳章
5#
發表於 2022-9-14 09:28 | 只看該作者
感謝兩位先進指導samwang,Andy2483,一個問題有三種方法,收下慢慢學習,感恩.
杜小平

TOP

        靜思自在 : 一個人的快樂．不是因為他擁有得多，而是因為他計較得少。
返回列表 上一主題