Code vba tách địa chỉ có sử dụng hàm tự tạo (1 người xem)

Thuyanhanoi · 4/4/17

Xin Chào các Anh chị và các bạn trên GPE
- Tôi có vấn đề sau mong được mọi người giúp đỡ!.
Tôi Sử dụng hàm tự tạo DiaChi như dưới đây khi viết code vba Tách địa chỉ:

Mã:

Public Function DiaChi(Chuoi As String, Optional So As Byte = 4) As String
Dim I As Byte, Tam
Tam = Split("----" & Chuoi, "-")
I = UBound(Tam) + So - 4
DiaChi = Tam(I)
End Function

Code tach dia chi

Mã:

Public Sub Tach_dia_danh()
    Dim I, J, k, l, m, n, lr, R As Long
    Dim sArr(), dArr()
    
With Sheets("Data")
    sArr = .Range("A6", .Range("A6").End(xlDown)).Resize(, 13).Value:    R = UBound(sArr)
End With
ReDim dArr(1 To R, 1 To 16)
    For I = 1 To R
    If sArr(I, 1) <> "" Then
        k = k + 1
        dArr(k, 1) = k
        For J = 2 To 12
            dArr(k, J) = sArr(I, J)
        Next J
        dArr(k, 13) = DiaChi(sArr(I, 13), 1)
        dArr(k, 14) = DiaChi(sArr(I, 13), 2)
        dArr(k, 15) = DiaChi(sArr(I, 13), 3)
        dArr(k, 16) = DiaChi(sArr(I, 13), 4)
    End If
Next I
With Sheets("Tach_dia_danh")
    .[A6].Resize(k, 16).ClearContents
    .[A6].Resize(k, 16).Value = dArr
End With
End Sub

Nhưng code trên không hoạt động được, mong mọi người chỉ giúp tôi xem tôi bị sai chỗ nào mà nó lại không chạy!.
Rất cảm ơn sự giúp đỡ của mọi người!.

TheThienChu · 4/4/17

Bạn định tách cột nào của data vậy

giaiphap · 4/4/17

Thuyanhanoi đã viết:
Xin Chào các Anh chị và các bạn trên GPE
- Tôi có vấn đề sau mong được mọi người giúp đỡ!.
Tôi Sử dụng hàm tự tạo DiaChi như dưới đây khi viết code vba Tách địa chỉ:

Mã:

Public Function DiaChi(Chuoi As String, Optional So As Byte = 4) As String Dim I As Byte, Tam Tam = Split("----" & Chuoi, "-") I = UBound(Tam) + So - 4 DiaChi = Tam(I) End Function

Code tach dia chi

Mã:

Public Sub Tach_dia_danh() Dim I, J, k, l, m, n, lr, R As Long Dim sArr(), dArr() With Sheets("Data") sArr = .Range("A6", .Range("A6").End(xlDown)).Resize(, 13).Value: R = UBound(sArr) End With ReDim dArr(1 To R, 1 To 16) For I = 1 To R If sArr(I, 1) <> "" Then k = k + 1 dArr(k, 1) = k For J = 2 To 12 dArr(k, J) = sArr(I, J) Next J dArr(k, 13) = DiaChi(sArr(I, 13), 1) dArr(k, 14) = DiaChi(sArr(I, 13), 2) dArr(k, 15) = DiaChi(sArr(I, 13), 3) dArr(k, 16) = DiaChi(sArr(I, 13), 4) End If Next I With Sheets("Tach_dia_danh") .[A6].Resize(k, 16).ClearContents .[A6].Resize(k, 16).Value = dArr End With End Sub

Nhưng code trên không hoạt động được, mong mọi người chỉ giúp tôi xem tôi bị sai chỗ nào mà nó lại không chạy!.
Rất cảm ơn sự giúp đỡ của mọi người!.

Bạn sửa hàm DiaChi như thế này nhé.

Mã:

Public Function DiaChi(Chuoi, Optional So As Byte = 4) As String
Dim I As Byte, Tam
Tam = Split("----" & Chuoi, "-")
I = UBound(Tam) + So - 4
DiaChi = Tam(I)
End Function

befaint · 4/4/17

@Thuyanhanoi:

Mã:

Public Function DiaChi(ByVal Chuoi As String) As Variant
Dim i As Long, tmp As Variant, No As Long, ct As Byte, T As Variant
tmp = Split("-" & Chuoi & "-", "-"): No = UBound(tmp)
ReDim dArr(1 To 4): ct = 4
If No > 2 Then
    For i = No To LBound(tmp) Step -1
        If ct = 1 Then Exit For
        T = tmp(i)
        If T <> "" Then
            dArr(ct) = WorksheetFunction.Trim(T)
            ct = ct - 1
        End If
    Next i
End If
i = InStr(Chuoi, dArr(2))
If i > 1 Then dArr(1) = WorksheetFunction.Trim(Left(Chuoi, i - 2))
DiaChi = dArr        'Kết quả trả về mảng 1 chiều gồm 4 phần tử.
End Function

Ba Tê · 4/4/17

Thuyanhanoi đã viết:
Xin Chào các Anh chị và các bạn trên GPE
- Tôi có vấn đề sau mong được mọi người giúp đỡ!.
Tôi Sử dụng hàm tự tạo DiaChi như dưới đây khi viết code vba Tách địa chỉ:

Nhưng code trên không hoạt động được, mong mọi người chỉ giúp tôi xem tôi bị sai chỗ nào mà nó lại không chạy!.
Rất cảm ơn sự giúp đỡ của mọi người!.

Bạn xem lại file này, nếu kết quả "tào lao" thì xem lại dữ liệu nguồn.

Thuyanhanoi · 4/4/17

befaint đã viết:

@Thuyanhanoi:

Mã:

Public Function DiaChi(ByVal Chuoi As String) As Variant
Dim i As Long, tmp As Variant, No As Long, ct As Byte, T As Variant
tmp = Split("-" & Chuoi & "-", "-"): No = UBound(tmp)
ReDim dArr(1 To 4): ct = 4
If No > 2 Then
    For i = No To LBound(tmp) Step -1
        If ct = 1 Then Exit For
        T = tmp(i)
        If T <> "" Then
            dArr(ct) = WorksheetFunction.Trim(T)
            ct = ct - 1
        End If
    Next i
End If
i = InStr(Chuoi, dArr(2))
If i > 1 Then dArr(1) = WorksheetFunction.Trim(Left(Chuoi, i - 2))
DiaChi = dArr        'Kết quả trả về mảng 1 chiều gồm 4 phần tử.
End Function

Cảm ơn bạn đã giúp mình.

ndu96081631 · 4/4/17

Thuyanhanoi đã viết:
Xin Chào các Anh chị và các bạn trên GPE
- Tôi có vấn đề sau mong được mọi người giúp đỡ!.
Tôi Sử dụng hàm tự tạo DiaChi như dưới đây khi viết code vba Tách địa chỉ:

Mã:

Public Function DiaChi([COLOR=#ff0000]Chuoi As String, Optional So As Byte = 4[/COLOR]) As String Dim I As Byte, Tam Tam = Split("----" & Chuoi, "-") I = UBound(Tam) + So - 4 DiaChi = Tam(I) End Function

Nhưng code trên không hoạt động được, mong mọi người chỉ giúp tôi xem tôi bị sai chỗ nào mà nó lại không chạy!.
Rất cảm ơn sự giúp đỡ của mọi người!.

Hàm của bạn báo lỗi vầy:

Mã:

ByRef argument type mismatch

Có nghĩa là chỗ màu đỏ trong code của bạn phải sửa thành vầy:

Mã:

Public Function DiaChi([COLOR=#ff0000][B]ByVal[/B] Chuoi As String, Optional [B]ByVal[/B] So As Byte = 4[/COLOR]) As String
Dim I As Byte, Tam
Tam = Split("----" & Chuoi, "-")
I = UBound(Tam) + So - 4
DiaChi = Tam(I)
End Function

Thử sửa lại xem có chạy được không?

Thuyanhanoi · 4/4/17

Ba Tê đã viết:
Bạn xem lại file này, nếu kết quả "tào lao" thì xem lại dữ liệu nguồn.

Em cảm ơn Thầy!. Code Thầy sửa lại cho em kết quả như mong muốn rồi ạ. Đúng là file dữ liệu gốc của em chưa chuẩn, vì nhiều người nhập nên mỗi người gõ một kiểu.

Thuyanhanoi · 4/4/17

ndu96081631 đã viết:
Hàm của bạn báo lỗi vầy:

Mã:

ByRef argument type mismatch

Có nghĩa là chỗ màu đỏ trong code của bạn phải sửa thành vầy:

Mã:

Public Function DiaChi([COLOR=#ff0000][B]ByVal[/B] Chuoi As String, Optional [B]ByVal[/B] So As Byte = 4[/COLOR]) As String Dim I As Byte, Tam Tam = Split("----" & Chuoi, "-") I = UBound(Tam) + So - 4 DiaChi = Tam(I) End Function

Thử sửa lại xem có chạy được không?

Cảm ơn anh ạ. Đúng như anh hướng dẫn em sửa lại. Code chạy luôn. (Hic hic do em chưa biết cách khai báo với function)

Code vba tách địa chỉ có sử dụng hàm tự tạo (1 người xem)

Người dùng đang xem chủ đề này

Thuyanhanoi

Thành viên thường trực

File đính kèm

TheThienChu

Thành viên tiêu biểu

giaiphap

==(^o^)==

befaint

|||||||||||||

Ba Tê

Cạo Rồi Khỏi Gội

File đính kèm

Thuyanhanoi

Thành viên thường trực

ndu96081631

Huyền thoại GPE

Thuyanhanoi

Thành viên thường trực

Thuyanhanoi

Thành viên thường trực

Bài viết mới nhất

Thành viên có số lượng bài viết cao nhất tháng

Thành viên có điểm tương tác cao nhất tháng

Đếm ngược thời gian