Nhờ các anh chị tách dãy số dữ liệu copy và paste value từ Facebook. (4 người xem)

[Huy Hoàng 12]

Em có cột A em copy các comment trên fb trong com ment có những dãy số.
Em muốn tách lấy các dãy số vào cột B tương ứng với từng ô bên cột A.
Cảm ơn các bác!

 

[Ba Tê]

Em có cột A em copy các comment trên fb trong com ment có những dãy số.
Em muốn tách lấy các dãy số vào cột B tương ứng với từng ô bên cột A.
Cảm ơn các bác!

Public Sub GPE()
Dim sArr(), dArr(), I As Long, J As Long, R As Long
    sArr = Range("A1", Range("A1").End(xlDown)).Value
    R = UBound(sArr)
    ReDim dArr(1 To R, 1 To 1)
For I = 1 To R
    For J = 1 To Len(sArr(I, 1))
        If IsNumeric(Mid(sArr(I, 1), J, 1)) Then
            If Len(Mid(sArr(I, 1), J, Len(sArr(I, 1)))) > 20 Then dArr(I, 1) = Mid(sArr(I, 1), J, Len(sArr(I, 1)))
            Exit For
        End If
    Next J
Next I
    Range("B1").Resize(R) = dArr
End Sub

 

[Huy Hoàng 12]

Public Sub GPE()
Dim sArr(), dArr(), I As Long, J As Long, R As Long
    sArr = Range("A1", Range("A1").End(xlDown)).Value
    R = UBound(sArr)
    ReDim dArr(1 To R, 1 To 1)
For I = 1 To R
    For J = 1 To Len(sArr(I, 1))
        If IsNumeric(Mid(sArr(I, 1), J, 1)) Then
            If Len(Mid(sArr(I, 1), J, Len(sArr(I, 1)))) > 20 Then dArr(I, 1) = Mid(sArr(I, 1), J, Len(sArr(I, 1)))
            Exit For
        End If
    Next J
Next I
    Range("B1").Resize(R) = dArr
End Sub

Cảm ơn bác ! Bác giúp em đoạn code xóa những dòng mà tương ứng với ô trống trong cột B được không ạ?

 

[Ba Tê]

Cảm ơn bác ! Bác giúp em đoạn code xóa những dòng mà tương ứng với ô trống trong cột B được không ạ?

Public Sub GPE()
Dim sArr(), dArr(), I As Long, J As Long, K As Long, R As Long
    sArr = Range("A1", Range("A1").End(xlDown)).Value
    R = UBound(sArr)
    ReDim dArr(1 To R, 1 To 2)
For I = 1 To R
    If Len(sArr(I, 1)) > 20 Then
        K = K + 1
        For J = 1 To Len(sArr(I, 1))
            If IsNumeric(Mid(sArr(I, 1), J, 1)) Then
                dArr(K, 1) = sArr(I, 1)
                dArr(K, 2) = Mid(sArr(I, 1), J, Len(sArr(I, 1)))
                Exit For
            End If
        Next J
    End If
Next I
    Range("A1").Resize(R).ClearContents
    Range("A1").Resize(K, 2) = dArr
End Sub

 

[Huy Hoàng 12]

Public Sub GPE()
Dim sArr(), dArr(), I As Long, J As Long, K As Long, R As Long
    sArr = Range("A1", Range("A1").End(xlDown)).Value
    R = UBound(sArr)
    ReDim dArr(1 To R, 1 To 2)
For I = 1 To R
    If Len(sArr(I, 1)) > 20 Then
        K = K + 1
        For J = 1 To Len(sArr(I, 1))
            If IsNumeric(Mid(sArr(I, 1), J, 1)) Then
                dArr(K, 1) = sArr(I, 1)
                dArr(K, 2) = Mid(sArr(I, 1), J, Len(sArr(I, 1)))
                Exit For
            End If
        Next J
    End If
Next I
    Range("A1").Resize(R).ClearContents
    Range("A1").Resize(K, 2) = dArr
End Sub

TKS BÁC BA TÊ.

 

[ndu96081631]

Em có cột A em copy các comment trên fb trong com ment có những dãy số.
Em muốn tách lấy các dãy số vào cột B tương ứng với từng ô bên cột A.
Cảm ơn các bác!

Bạn xóa file đính kèm sau khi xong việc, topic trở nên vô duyên đến lạ thường
???!!!
Mai này ai đó vào đây đọc, tin chắc không hiểu chuyện gì đang diễn ra

 

[Gà Công Nghệ]

Public Sub GPE()
Dim sArr(), dArr(), I As Long, J As Long, K As Long, R As Long
    sArr = Range("A1", Range("A1").End(xlDown)).Value
    R = UBound(sArr)
    ReDim dArr(1 To R, 1 To 2)
For I = 1 To R
    If Len(sArr(I, 1)) > 20 Then
        K = K + 1
        For J = 1 To Len(sArr(I, 1))
            If IsNumeric(Mid(sArr(I, 1), J, 1)) Then
                dArr(K, 1) = sArr(I, 1)
                dArr(K, 2) = Mid(sArr(I, 1), J, Len(sArr(I, 1)))
                Exit For
            End If
        Next J
    End If
Next I
    Range("A1").Resize(R).ClearContents
    Range("A1").Resize(K, 2) = dArr
End Sub

Thầy Ba Tê cho em xin bài tham thảo với, chủ thớt xóa bài đăng mất tiêu.

 

[Ba Tê]

Thầy Ba Tê cho em xin bài tham thảo với, chủ thớt xóa bài đăng mất tiêu.

 

[Ba Tê]

Chập chờn gởi 1 bài thành 2, xin xóa bài này.

 

[Gà Công Nghệ]

Dạ, cám ơn thầy Ba Tê nhiều. Chúc thầy cuối tuần vui vẻ.