การรวมข้อความในแบบมีเงื่อนไข ใน Excel (VBA)

[Kanok]

สอบถามการรวมข้อมูลใน Excel โดยใ้คำสั่ง VBA

- ต้องการรวมข้อมูลในคอลัมภ์ D และ คอลัมภ์ E ไปไว้ในคอลัมภ์ A โดยมี "/ " ขั้นระหว่างข้อความ
- หากแถวใดมีข้อมูลเฉพาะ คอลัมภ์ D หรือ คอลัมภ์ E เพียงอย่าง เดียว ก็ให้ copy ข้อมูลไปวางใน คอลัมภ์ A โดยที่ไม่มีเครื่องหมาย "/ "

ที่ได้ลองเขียนโค้ดมา มีดังนี้

#1)ใช้ if เพื่อเช็คว่ามีข้อความใน คอลัมภ์ D และ คอลัมภ์ E ถ้ามี ให้รวมข้อความไปไว้ใน ในคอลัมภ์ A โดยมี "/ " ขั้นระหว่างข้อความ
#2) ถ้าในกรณีคอลัมภ์ E ว่าง ให้คัดลอกเฉพาะ คอลัมภ์ D ไปไว้ใน ในคอลัมภ์ A (โดยไม่มี "/ ")
#3) ถ้าในกรณีคอลัมภ์ D ว่าง ให้คัดลอกเฉพาะ คอลัมภ์ E ไปไว้ใน ในคอลัมภ์ A (โดยไม่มี "/ ")

Code: Select all

Sub combinetext()

Dim D1 As String
Dim D2 As String
 
lastrow = Worksheets("sheet1").Cells(Rows.Count, 1).End(xlUp).Row

For i = 2 To lastrow
    D1 = Cells(i, 4)
    D2 = Cells(i, 5)
       If Data1.Value & Data2.Value Is Not Empty Then
       	 Cells(i, 1) = Cells(i, 4) & "/" & Cells(i, 5)
       If Cells(i, 5) Is Empty Then
        	Cells(i, 1) = Cells(i, 4)
       If Cells(i, 4) Is Empty Then
    Cells(i, 1) = Cells(i, 5)
     
End If
Next i
End Sub

combine text.xlsm

PQ5_Combine text.jpg

[parakorn]

ใช้สูตรช่วย ก่อน ใช้คำสั่ง Copy ได้ไหมครับ หากได้
ที่ F2 พิมพ์ =IF(D2="",E2,IF(E2="",D2,IF(AND(D2<>"",E2<>""),D2&"/"&E2)))
Copy ลากลงด้านล่าง

หากต้องการแต่ VBA เดี๋ยวรอท่านอื่นๆมาตอบครับ

[niwat2811]

ลองแบบนี้ดูว่าใช้ได้ตามต้องการไหมครับ

Code: Select all

Sub combinetext()
Dim LR As Long
LR = Cells.Find(What:="*", SearchDirection:=xlPrevious, SearchOrder:=xlByRows).Row
For Each r In Range("D2:D" & LR)
    If r.Value <> "" And r.Offset(0, 1) = "" Then
        r.Offset(0, -3).Value = r.Value
    End If
    If r.Value = "" And r.Offset(0, 1) <> "" Then
        r.Offset(0, -3).Value = r.Offset(0, 1).Value
    End If
    If r.Value <> "" And r.Offset(0, 1).Value <> "" Then
        r.Offset(0, -3).Value = r & "" & "/" & "" & r.Offset(0, 1)
    End If
Next r
End Sub

[Kanok]

ใช้สูตรช่วย ก่อน ใช้คำสั่ง Copy ได้ไหมครับ หากได้
ที่ F2 พิมพ์ =IF(D2="",E2,IF(E2="",D2,IF(AND(D2<>"",E2<>""),D2&"/"&E2)))
Copy ลากลงด้านล่าง

หากต้องการแต่ VBA เดี๋ยวรอท่านอื่นๆมาตอบครับ

ขอบคุณค่ะ

[Kanok]

ลองแบบนี้ดูว่าใช้ได้ตามต้องการไหมครับ

Code: Select all

Sub combinetext()
Dim LR As Long
LR = Cells.Find(What:="*", SearchDirection:=xlPrevious, SearchOrder:=xlByRows).Row
For Each r In Range("D2:D" & LR)
    If r.Value <> "" And r.Offset(0, 1) = "" Then
        r.Offset(0, -3).Value = r.Value
    End If
    If r.Value = "" And r.Offset(0, 1) <> "" Then
        r.Offset(0, -3).Value = r.Offset(0, 1).Value
    End If
    If r.Value <> "" And r.Offset(0, 1).Value <> "" Then
        r.Offset(0, -3).Value = r & "" & "/" & "" & r.Offset(0, 1)
    End If
Next r
End Sub

รันได้ตามที่ต้องการค่ะ
ขอบคุณค่ะ

[Kanok]

ขอถามเพิ่มติมได้หรือเปล่าค่ะ ว่า บรรทัดนี้ มีความหมายว่าอย่างไร

LR = Cells.Find(What:="*", SearchDirection:=xlPrevious, SearchOrder:=xlByRows).Row

[snasui]

เป็นการกำหนดค่าให้กับตัวแปร LR โดยให้มีค่าเท่ากับบรรทัดสุดท้ายที่ไม่เป็นเซลล์ว่างครับ

[Kanok]

เป็นการกำหนดค่าให้กับตัวแปร LR โดยให้มีค่าเท่ากับบรรทัดสุดท้ายที่ไม่เป็นเซลล์ว่างครับ

ขอบคุณมากค่ะสำหรับคำอธิบายเพิ่มเติม