String Manupulation ใน VBA

ฉันมีคอลัมน์เดียวที่ต้องแยกเป็นหลายคอลัมน์เช่น Text-to-Column ใน excel อย่างไรก็ตามมีความท้าทายเล็กน้อย ตัวคั่นธรรมดาจะไม่ทำงาน พิจารณาสตริงด้านล่าง

Original: Domain\Domain Admins Domain2\User Group Domain3\Developers .....(And so on)
Required: Domain\Domain Admins | Domain2\User Group | Domain3\Developers .....(And so on)

ไพพ์ในสตริงที่ต้องการหมายความว่าต้องแยกที่นี่และคัดลอกไปยังคอลัมน์ถัดไปตามความยาวของสตริง

ฉันมีรายการในคอลัมน์ A ที่มี 506 แถว ฉันใช้สูตรต่อไปนี้เพื่อตรวจสอบการเกิดขึ้นของ "\" ฉันคอลัมน์ B นับช่วงตั้งแต่ 0-66

=LEN(A2)-LEN(SUBSTITUTE(A2,"\",""))

ฉันต้องการความช่วยเหลือในการเขียนโค้ดตามตรรกะ

1. ค้นหา "\" ในสตริง
2. ค้นหาช่องว่างก่อน "\" และแยก

ฉันใช้รหัสต่อไปนี้ แต่ไม่ได้มีวัตถุประสงค์

Range("A1:A506").Select
Selection.TextToColumns 

กรุณาช่วยด้วยรหัสที่เก็บคะแนน 1 และ 2 ในใจ

สิ่งนี้ควรทำแม้ว่าฉันจะใช้ตรรกะที่แตกต่างกับความต้องการของคุณ

คุณต้องการที่จะหา \ ก่อนหน้า white space ซึ่งเป็นรหัสของฉันมองหาDomain(หมายเหตุช่องว่าง)

Option Explicit

Sub DoThis()

Dim col As Integer
col = 65

Dim splitWord As String
splitWord = "Domain"

Dim row As Integer
row = 1

Do While (Range("A" & row).value <> "")

Dim value As String

value = Range("A" & row).value

Dim values() As String

values = Split(value, " " & splitWord)

Dim firstResult As String

Dim i As Integer

For i = 1 To UBound(values)

firstResult = values(0) ' not efficient but easier code to read

Range(Chr(col + i) & row).value = splitWord & values(i)

Next i

Range(Chr(col) & row).value = firstResult
row = row + 1
col = 65
Loop

End Sub

ก่อน

หลังจาก

โปรดทราบว่าฉันได้อัปเดตบางคำเล็กน้อยเพื่อแสดงว่าเป็นการคัดลอกข้อมูลที่ถูกต้อง แต่ได้รับการทดสอบกับตัวอย่างของคุณแล้วเช่นกัน

ก่อนที่คุณจะทำการทดสอบตรวจสอบให้แน่ใจว่าได้สร้างการสำรองข้อมูลของคุณก่อนเนื่องจากแมโครของสิ่งนี้ไม่สามารถเลิกทำได้!

Sub ExtractBySlash ()

Dim r As Range

Dim subS As Variant

สลัว x นาน

ติ่ม y ตราบใด

ติ่มซำตราบเท่า

ตัวนับ = 1

สำหรับ Each r In Range ("a1: a506")

subS = Split(r.Text, "\")

For x = LBound(subS) + 1 To UBound(subS)

    For y = Len(subS(x)) To 1 Step -1

        If Mid(subS(x), y, 1) = " " Then

            r.Offset(0, counter) = subS(x - 1) & "\" & Left(subS(x), y)

            subS(x) = Trim(Right(subS(x), Len(subS(x)) - y))

            counter = counter + 1

            Exit For

        End If

    Next y

Next x

ถัดไป

ส่วนท้าย