Xin hàm xắp xếp dữ liệu của bảng vào cột hoặc hàng (1 người xem)

  • Thread starter Thread starter nvh611
  • Ngày gửi Ngày gửi
Liên hệ QC

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

Đang trực tuyến: 1 (Thành viên: 0, Khách: 1)
Sắp xếp theo thời gian sắp xếp theo bầu chọn
nvh611 đã viết:
Nhờ các bạn trên diễn đàn viết giúp hàm như file đính kèm
Nhấp chuột vào đây để mở rộng...
Đây nhé bạn xem.
Mã: 
Function chuyendulieu(ByVal mang As Range, ByVal dk As Boolean)
        Dim arr, arr1, i As Long, j As Long
        arr = mang.Value
        ReDim arr1(1 To UBound(arr, 1) * UBound(arr, 2))
        For i = 1 To UBound(arr, 1)
            For j = 1 To UBound(arr, 2)
                If Len(arr(i, j)) > 0 Then
                   a = a + 1
                   arr1(a) = arr(i, j)
                End If
           Next j
      Next i
      If dk = True Then
         chuyendulieu = arr1
      Else
         chuyendulieu = Application.Transpose(arr1)
      End If
End Function
 

File đính kèm

Upvote 0
snow25 đã viết:
Đây nhé bạn xem.
Mã: 
Function chuyendulieu(ByVal mang As Range, ByVal dk As Boolean)
        Dim arr, arr1, i As Long, j As Long
        arr = mang.Value
        ReDim arr1(1 To UBound(arr, 1) * UBound(arr, 2))
        For i = 1 To UBound(arr, 1)
            For j = 1 To UBound(arr, 2)
                If Len(arr(i, j)) > 0 Then
                   a = a + 1
                   arr1(a) = arr(i, j)
                End If
           Next j
      Next i
      If dk = True Then
         chuyendulieu = arr1
      Else
         chuyendulieu = Application.Transpose(arr1)
      End If
End Function
Nhấp chuột vào đây để mở rộng...
Cảm ơn bạn @snow25 bạn ơi công thức vẫn bị lỗi khi trong mảng có lỗi vậy nhờ bạn sửa giúp như sau
- Lấy thêm nhiều mảng
- Khi không có dữ liệu thì ="khong" (Hiện tại bây giờ là công thức trả về số "0"
- Khi trong mảng có các lỗi Value; Div; Name thì hàm không hoạt đống
Bạn xem và sửa giúp mình nhé
Cảm ơn bạn!
 

File đính kèm

Upvote 0
nvh611 đã viết:
Cảm ơn bạn @snow25 bạn ơi công thức vẫn bị lỗi khi trong mảng có lỗi vậy nhờ bạn sửa giúp như sau
- Lấy thêm nhiều mảng
- Khi không có dữ liệu thì ="khong" (Hiện tại bây giờ là công thức trả về số "0"
- Khi trong mảng có các lỗi Value; Div; Name thì hàm không hoạt đống
Bạn xem và sửa giúp mình nhé
Cảm ơn bạn!
Nhấp chuột vào đây để mở rộng...
Bạn chạy thử cái này xem.
Mã: 
Function chuyendulieu(ByVal dk As Boolean, ParamArray mang())
        Dim arr(1 To 1000), T, T1, a As Long
            For Each T In mang
            For Each T1 In T
                If InStr(T1.Text, "#") = 0 Then
                   If Len(T1.Value) > 0 Then
                      a = a + 1
                      arr(a) = T1.Value
                   End If
                End If
           Next
       Next
      If dk = True Then
         chuyendulieu.Resize(a) = arr
      Else
         chuyendulieu = Application.Transpose(arr)
      End If
End Function
Mã: 
=chuyendulieu(FALSE,C2:E6)
 
Upvote 0
snow25 đã viết:
Bạn chạy thử cái này xem.
Mã: 
Function chuyendulieu(ByVal dk As Boolean, ParamArray mang())
        Dim arr(1 To 1000), T, T1, a As Long
            For Each T In mang
            For Each T1 In T
                If InStr(T1.Text, "#") = 0 Then
                   If Len(T1.Value) > 0 Then
                      a = a + 1
                      arr(a) = T1.Value
                   End If
                End If
           Next
       Next
      If dk = True Then
         chuyendulieu.Resize(a) = arr
      Else
         chuyendulieu = Application.Transpose(arr)
      End If
End Function
Mã: 
=chuyendulieu(FALSE,C2:E6)
Nhấp chuột vào đây để mở rộng...
Cảm ơn bạn
Hàm đã đưa được vào cột
Bạn giúp mình chuyển sang hàng với nhé
 
Upvote 0
nvh611 đã viết:
Nhưng phần này vẫn bị lỗi bạn @snow25 ơi
Nhấp chuột vào đây để mở rộng...
Bạn sửa theo code này nhé.
Mã: 
Function chuyendulieu(ByVal dk As Boolean, ParamArray mang())
        Dim arr(1 To 1000), T, T1, a As Long
            For Each T In mang
            For Each T1 In T
                If InStr(T1.Text, "#") = 0 Then
                   If Len(T1.Value) > 0 Then
                      a = a + 1
                      arr(a) = T1.Value
                   End If
                End If
           Next
       Next
      If dk = True Then
         chuyendulieu = arr
      Else
         chuyendulieu = Application.Transpose(arr)
      End If
End Function
 
Upvote 0
snow25 đã viết:
Bạn sửa theo code này nhé.
Nhấp chuột vào đây để mở rộng...
Sửa code của snow25 một chút được không nhé:
Mã: 
Function chuyendulieu(ByVal dk As Boolean, Numb As Integer, ParamArray mang())
        Dim arr(1 To 1000), T, T1, a As Long
            For Each T In mang
            For Each T1 In T
                If InStr(T1.Text, "#") = 0 Then
                   If Len(T1.Value) > 0 Then
                      a = a + 1
                      arr(a) = T1.Value
                   End If
                End If
           Next
       Next
      If dk = True Then
         chuyendulieu = arr(Numb)
      Else
         chuyendulieu = Application.Transpose(arr(Numb))
      End If
End Function
Sử dụng công thức để kéo theo dòng: =chuyendulieu(TRUE,ROW($A1),$C$2:$E$6)
Hoặc kéo theo cột: =chuyendulieu(FALSE,COLUMN(A$1),$C$2:$E$6)
 
Upvote 0
snow25 đã viết:
Bạn sửa theo code này nhé.
Mã: 
Function chuyendulieu(ByVal dk As Boolean, ParamArray mang())
        Dim arr(1 To 1000), T, T1, a As Long
            For Each T In mang
            For Each T1 In T
                If InStr(T1.Text, "#") = 0 Then
                   If Len(T1.Value) > 0 Then
                      a = a + 1
                      arr(a) = T1.Value
                   End If
                End If
           Next
       Next
      If dk = True Then
         chuyendulieu = arr
      Else
         chuyendulieu = Application.Transpose(arr)
      End If
End Function
Nhấp chuột vào đây để mở rộng...
Cảm ơn bạn @snow25
Bạn ơi sao nó phát sinh ra những số "0" nhỉ
Bạn xem và chỉnh sửa giúp mình nhé
Bài đã được tự động gộp:

leonguyenz đã viết:
Sửa code của snow25 một chút được không nhé:
Mã: 
Function chuyendulieu(ByVal dk As Boolean, Numb As Integer, ParamArray mang())
        Dim arr(1 To 1000), T, T1, a As Long
            For Each T In mang
            For Each T1 In T
                If InStr(T1.Text, "#") = 0 Then
                   If Len(T1.Value) > 0 Then
                      a = a + 1
                      arr(a) = T1.Value
                   End If
                End If
           Next
       Next
      If dk = True Then
         chuyendulieu = arr(Numb)
      Else
         chuyendulieu = Application.Transpose(arr(Numb))
      End If
End Function
Sử dụng công thức để kéo theo dòng: =chuyendulieu(TRUE,ROW($A1),$C$2:$E$6)
Hoặc kéo theo cột: =chuyendulieu(FALSE,COLUMN(A$1),$C$2:$E$6)
Nhấp chuột vào đây để mở rộng...
Cảm ơn bạn @
leonguyenz
công thức hay quá, không phải dùng công thức mảng
Nhưng công thức của bạn vẫn phát sinh ra số "0"
Vậy nhờ bạn chỉnh sửa giúp mình nhé
Xin trân thành cảm ơn!
 

File đính kèm

Lần chỉnh sửa cuối:
Upvote 0
nvh611 đã viết:
Cảm ơn bạn @snow25
Bạn ơi sao nó phát sinh ra những số "0" nhỉ
Bạn xem và chỉnh sửa giúp mình nhé
Bài đã được tự động gộp:


Cảm ơn bạn @
leonguyenz
công thức hay quá, không phải dùng công thức mảng
Nhưng công thức của bạn vẫn phát sinh ra số "0"
Vậy nhờ bạn chỉnh sửa giúp mình nhé
Xin trân thành cảm ơn!
Nhấp chuột vào đây để mở rộng...
Đây là file chính thức hay chưa bạn, có thay đổi hay điều kiện gì nữa không?
 
Upvote 0
Vậy sửa thêm một chút:
Mã: 
Function chuyendulieu(ByVal dk As Boolean, Numb As Integer, ParamArray mang())
    Dim arr(1 To 1000), T, T1, a As Long
        For Each T In mang
            For Each T1 In T
                If InStr(T1.Text, "#") = 0 Then
                    If Len(T1.Value) > 0 Then
                        a = a + 1
                        arr(a) = T1.Value
                    End If
                End If
            Next
        Next
        If a < Numb Then
            chuyendulieu = ""
        ElseIf dk = True Then
            chuyendulieu = arr(Numb)
        Else
            chuyendulieu = Application.Transpose(arr(Numb))
        End If
End Function
 
Upvote 0
nvh611 đã viết:
Nhờ các bạn trên diễn đàn viết giúp hàm như file đính kèm
Nhấp chuột vào đây để mở rộng...
Mã: 
Function JoinData(ByVal id As Long, ParamArray sRng()) As Variant
    Dim Res, Rng, Cel, k As Long
    JoinData = ""
    For Each Rng In sRng
      For Each Cel In Rng
        Res = Cel.Value
        If TypeName(Res) <> "Error" Then
          If Len(Res) > 0 Then
            k = k + 1
            If k = id Then JoinData = Res: Exit Function
          End If
        End If
      Next
    Next
End Function
 

File đính kèm

Upvote 0
leonguyenz đã viết:
Vậy sửa thêm một chút:
Mã: 
Function chuyendulieu(ByVal dk As Boolean, Numb As Integer, ParamArray mang())
    Dim arr(1 To 1000), T, T1, a As Long
        For Each T In mang
            For Each T1 In T
                If InStr(T1.Text, "#") = 0 Then
                    If Len(T1.Value) > 0 Then
                        a = a + 1
                        arr(a) = T1.Value
                    End If
                End If
            Next
        Next
        If a < Numb Then
            chuyendulieu = ""
        ElseIf dk = True Then
            chuyendulieu = arr(Numb)
        Else
            chuyendulieu = Application.Transpose(arr(Numb))
        End If
End Function
Nhấp chuột vào đây để mở rộng...
Hay quá bạn
leonguyenz
Cảm ơn bạn!
Bạn thêm cho mình 1 điều kiện nữa được không?
Thêm điều kiện cho trường hợp không lấy trùng
Mong bạn sửa giúp thêm điều kiện nữa nhé!
 
Upvote 0
Upvote 0
leonguyenz đã viết:
Bạn trả lời bài #11 trước nhé.
Nhấp chuột vào đây để mở rộng...
Bạn

leonguyenz tất nhiên bài này tiêu chí của mình là:
- Xắp xếp dữ liệu của 1 hoặc nhiều bảng vào cột hoặc hàng
1- Trường hợp thứ nhất là lấy toàn bộ các dữ liệu của những bảng đó
2- Trường hợp thứ 2 là lấy dữ liệu ngưng loại bỏ trùng (Nếu trùng thì chỉ lấy 1)
Mong bạn trợ giúp
Cảm ơn bạn!
Bài đã được tự động gộp:

CHAOQUAY đã viết:
Đây là file chính thức hay chưa bạn, có thay đổi hay điều kiện gì nữa không?
Nhấp chuột vào đây để mở rộng...
Chào bạn @CHAOQUAY bài này tiêu chí của mình là:
- Xắp xếp dữ liệu của 1 hoặc nhiều bảng vào cột hoặc hàng
1- Trường hợp thứ nhất là lấy toàn bộ các dữ liệu của những bảng đó
2- Trường hợp thứ 2 là lấy dữ liệu ngưng loại bỏ trùng (Nếu trùng thì chỉ lấy 1)
Bài đã được tự động gộp:

HieuCD đã viết:
Mã: 
Function JoinData(ByVal id As Long, ParamArray sRng()) As Variant
    Dim Res, Rng, Cel, k As Long
    JoinData = ""
    For Each Rng In sRng
      For Each Cel In Rng
        Res = Cel.Value
        If TypeName(Res) <> "Error" Then
          If Len(Res) > 0 Then
            k = k + 1
            If k = id Then JoinData = Res: Exit Function
          End If
        End If
      Next
    Next
End Function
Nhấp chuột vào đây để mở rộng...
Hay quá hay quá, code rất ngắn gọn
Cảm ơn bạn @HieuCD
Bạn @HieuCD ơi bài của mình có tiêu chí như sau
- Xắp xếp dữ liệu của 1 hoặc nhiều bảng vào cột hoặc hàng
1- Trường hợp thứ nhất là lấy toàn bộ các dữ liệu của những bảng đó
2- Trường hợp thứ 2 là lấy dữ liệu ngưng loại bỏ trùng (Nếu trùng thì chỉ lấy 1)
Vậy mong bạn thêm cho mình tiêu chí thứ 2 nhé
Cảm ơn bạn rất nhiều!
 
Lần chỉnh sửa cuối:
Upvote 0
Trên code của bạn snow25, thêm Dic vào để lọc duy nhất.
Mã: 
Function chuyendulieu(ByVal dK As Boolean, Numb As Integer, ParamArray Mang())
    Application.ScreenUpdating = False
    Dim Arr(1 To 1000), T, T1, a As Long
        For Each T In Mang
            For Each T1 In T
                If InStr(T1.Text, "#") = 0 Then
                    If Len(T1.Value) > 0 Then
                        a = a + 1
                        Arr(a) = T1.Value
                    End If
                End If
            Next
        Next
        
        Dim Dic As Object
        Dim iR As Long, kR As Long, Tmp As String, dArr
        ReDim dArr(1 To UBound(Arr))
        Set Dic = CreateObject("Scripting.Dictionary")
        With Dic
            For iR = 1 To UBound(Arr)
                Tmp = Arr(iR)
                If Not .Exists(Tmp) Then
                    kR = kR + 1
                    .Add Tmp, kR
                    dArr(kR) = Arr(iR)
                End If
            Next iR
        End With
        
        If kR - 1 < Numb Then
            chuyendulieu = ""
        ElseIf dK = True Then
            chuyendulieu = dArr(Numb)
        Else
            chuyendulieu = Application.Transpose(dArr(Numb))
        End If
    Application.ScreenUpdating = True
End Function
 
Upvote 0
leonguyenz đã viết:
Trên code của bạn snow25, thêm Dic vào để lọc duy nhất.
Mã: 
Function chuyendulieu(ByVal dK As Boolean, Numb As Integer, ParamArray Mang())
    Application.ScreenUpdating = False
    Dim Arr(1 To 1000), T, T1, a As Long
        For Each T In Mang
            For Each T1 In T
                If InStr(T1.Text, "#") = 0 Then
                    If Len(T1.Value) > 0 Then
                        a = a + 1
                        Arr(a) = T1.Value
                    End If
                End If
            Next
        Next
       
        Dim Dic As Object
        Dim iR As Long, kR As Long, Tmp As String, dArr
        ReDim dArr(1 To UBound(Arr))
        Set Dic = CreateObject("Scripting.Dictionary")
        With Dic
            For iR = 1 To UBound(Arr)
                Tmp = Arr(iR)
                If Not .Exists(Tmp) Then
                    kR = kR + 1
                    .Add Tmp, kR
                    dArr(kR) = Arr(iR)
                End If
            Next iR
        End With
       
        If kR - 1 < Numb Then
            chuyendulieu = ""
        ElseIf dK = True Then
            chuyendulieu = dArr(Numb)
        Else
            chuyendulieu = Application.Transpose(dArr(Numb))
        End If
    Application.ScreenUpdating = True
End Function
Nhấp chuột vào đây để mở rộng...
Cảm ơn bạn
leonguyenz
bạn ơi hàm này tách riêng hàm trên hả bạn?
 
Upvote 0
nvh611 đã viết:
Bạn

leonguyenz tất nhiên bài này tiêu chí của mình là:
- Xắp xếp dữ liệu của 1 hoặc nhiều bảng vào cột hoặc hàng
1- Trường hợp thứ nhất là lấy toàn bộ các dữ liệu của những bảng đó
2- Trường hợp thứ 2 là lấy dữ liệu ngưng loại bỏ trùng (Nếu trùng thì chỉ lấy 1)
Mong bạn trợ giúp
Cảm ơn bạn!
Bài đã được tự động gộp:


Chào bạn @CHAOQUAY bài này tiêu chí của mình là:
- Xắp xếp dữ liệu của 1 hoặc nhiều bảng vào cột hoặc hàng
1- Trường hợp thứ nhất là lấy toàn bộ các dữ liệu của những bảng đó
2- Trường hợp thứ 2 là lấy dữ liệu ngưng loại bỏ trùng (Nếu trùng thì chỉ lấy 1)
Bài đã được tự động gộp:


Hay quá hay quá, code rất ngắn gọn
Cảm ơn bạn @HieuCD
Bạn @HieuCD ơi bài của mình có tiêu chí như sau
- Xắp xếp dữ liệu của 1 hoặc nhiều bảng vào cột hoặc hàng
1- Trường hợp thứ nhất là lấy toàn bộ các dữ liệu của những bảng đó
2- Trường hợp thứ 2 là lấy dữ liệu ngưng loại bỏ trùng (Nếu trùng thì chỉ lấy 1)
Vậy mong bạn thêm cho mình tiêu chí thứ 2 nhé
Cảm ơn bạn rất nhiều!
Nhấp chuột vào đây để mở rộng...
Vấn đề không phải là tiêu chí.
Nếu vùng dữ liệu của bạn là bất định thì việc dùng hàm có thể dẫn đến vùng hiển thị mong muốn có thể bị thừa hoặc là thiếu do quá trình nhập hàm.
Cá nhân tôi cho là yêu cầu dùng hàm tự tạo trong trường hợp này là sai lầm.

Chúc bạn may mắn!!!
 
Upvote 0
leonguyenz đã viết:
Bạn Coppy code dán vào, xóa code cũ.
Sử dụng công thức như bài #9.
Nhấp chuột vào đây để mở rộng...
Cái đó thì mình đã làm
Nhưng mà cú pháp của hàm thì mình không biết
Vì vậy nhờ bạn hướng dẫn cú pháp của hàm dùng cho các trường hợp
Cảm ơn bạn rất nhiều!
Bài đã được tự động gộp:

CHAOQUAY đã viết:
Vấn đề không phải là tiêu chí.
Nếu vùng dữ liệu của bạn là bất định thì việc dùng hàm có thể dẫn đến vùng hiển thị mong muốn có thể bị thừa hoặc là thiếu do quá trình nhập hàm.
Cá nhân tôi cho là yêu cầu dùng hàm tự tạo trong trường hợp này là sai lầm.

Chúc bạn may mắn!!!
Nhấp chuột vào đây để mở rộng...
Cảm ơn bạn
Vậy theo bạn thì nên dùng cái gì?
 
Upvote 0
Sử dụng công thức như bài #9:
- Kéo xuống theo từng dòng: =chuyendulieu(TRUE,ROW($A1),$C$2:$E$6)
- Kéo ngang theo từng cột: =chuyendulieu(FALSE,COLUMN(A$1),$C$2:$F$6)
 
Upvote 0
nvh611 đã viết:
Cái đó thì mình đã làm
Nhưng mà cú pháp của hàm thì mình không biết
Vì vậy nhờ bạn hướng dẫn cú pháp của hàm dùng cho các trường hợp
Cảm ơn bạn rất nhiều!
Bài đã được tự động gộp:


Cảm ơn bạn
Vậy theo bạn thì nên dùng cái gì?
Nhấp chuột vào đây để mở rộng...
Bạn hỏi thì có ý thế này : Việc này còn tùy thuộc bạn bố trí bảng biểu thế nào. Như bài của bạn có thể dùng sub với lựa chọn vùng trước.
Nếu cố dùng hàm mảng như bạn, tôi tin là kết quả hiển thị sẽ không đáng tin cậy mặc dù các code ở trên đều hoàn toàn chính xác.
 
Upvote 0
leonguyenz đã viết:
Sử dụng công thức như bài #9:
- Kéo xuống theo từng dòng: =chuyendulieu(TRUE,ROW($A1),$C$2:$E$6)
- Kéo ngang theo từng cột: =chuyendulieu(FALSE,COLUMN(A$1),$C$2:$F$6)
Nhấp chuột vào đây để mở rộng...
Nhưng bởi vì bạn nói là code của 2 bài là 1
Vì vậy khi không lấy trùng và khi lấy toàn bộ dữ liệu thì cú pháp của hàm như nào?
(Vậy thì 2 code của bạn là tách biệt đúng không hả bạn?)
 
Upvote 0
nvh611 đã viết:
Nhưng bởi vì bạn nói là code của 2 bài là 1
Vì vậy khi không lấy trùng và khi lấy toàn bộ dữ liệu thì cú pháp của hàm như nào?
(Vậy thì 2 code của bạn là tách biệt đúng không hả bạn?)
Nhấp chuột vào đây để mở rộng...
Sử dụng 1 code thôi, tham khảo file nhé.
 

File đính kèm

Upvote 0
nvh611 đã viết:
Bạn

leonguyenz tất nhiên bài này tiêu chí của mình là:
- Xắp xếp dữ liệu của 1 hoặc nhiều bảng vào cột hoặc hàng
1- Trường hợp thứ nhất là lấy toàn bộ các dữ liệu của những bảng đó
2- Trường hợp thứ 2 là lấy dữ liệu ngưng loại bỏ trùng (Nếu trùng thì chỉ lấy 1)
Mong bạn trợ giúp
Cảm ơn bạn!
Bài đã được tự động gộp:


Chào bạn @CHAOQUAY bài này tiêu chí của mình là:
- Xắp xếp dữ liệu của 1 hoặc nhiều bảng vào cột hoặc hàng
1- Trường hợp thứ nhất là lấy toàn bộ các dữ liệu của những bảng đó
2- Trường hợp thứ 2 là lấy dữ liệu ngưng loại bỏ trùng (Nếu trùng thì chỉ lấy 1)
Bài đã được tự động gộp:


Hay quá hay quá, code rất ngắn gọn
Cảm ơn bạn @HieuCD
Bạn @HieuCD ơi bài của mình có tiêu chí như sau
- Xắp xếp dữ liệu của 1 hoặc nhiều bảng vào cột hoặc hàng
1- Trường hợp thứ nhất là lấy toàn bộ các dữ liệu của những bảng đó
2- Trường hợp thứ 2 là lấy dữ liệu ngưng loại bỏ trùng (Nếu trùng thì chỉ lấy 1)
Vậy mong bạn thêm cho mình tiêu chí thứ 2 nhé
Cảm ơn bạn rất nhiều!
Nhấp chuột vào đây để mở rộng...
Mã: 
Function JoinData(ByVal id As Long, ByVal NoDouble As Boolean, ParamArray sRng()) As Variant
    Dim Res, Rng, Cel, k As Long, tmp As String
    JoinData = ""
    tmp = "|"
    For Each Rng In sRng
      For Each Cel In Rng
        Res = Cel.Value
        If TypeName(Res) <> "Error" Then
          If Len(Res) > 0 Then
            If NoDouble Then
              If InStr(1, tmp, "|" & Res & "|") = 0 Then
                k = k + 1
                If k = id Then JoinData = Res: Exit Function
                tmp = tmp & Res & "|"
              End If
            Else
              k = k + 1
              If k = id Then JoinData = Res: Exit Function
            End If
          End If
        End If
      Next
    Next
End Function
 

File đính kèm

Upvote 0
HieuCD đã viết:
Mã: 
Function JoinData(ByVal id As Long, ByVal NoDouble As Boolean, ParamArray sRng()) As Variant
    Dim Res, Rng, Cel, k As Long, tmp As String
    JoinData = ""
    tmp = "|"
    For Each Rng In sRng
      For Each Cel In Rng
        Res = Cel.Value
        If TypeName(Res) <> "Error" Then
          If Len(Res) > 0 Then
            If NoDouble Then
              If InStr(1, tmp, "|" & Res & "|") = 0 Then
                k = k + 1
                If k = id Then JoinData = Res: Exit Function
                tmp = tmp & Res & "|"
              End If
            Else
              k = k + 1
              If k = id Then JoinData = Res: Exit Function
            End If
          End If
        End If
      Next
    Next
End Function
Nhấp chuột vào đây để mở rộng...
Anh Hiếu Cái hàm Instr với Dictionary cái nào nhanh hơn anh.Vì em thấy khi mình ghép ký tự nhiều quá có ảnh hưởng gì không ạ,
 
Upvote 0
HieuCD đã viết:
Mã: 
Function JoinData(ByVal id As Long, ByVal NoDouble As Boolean, ParamArray sRng()) As Variant
    Dim Res, Rng, Cel, k As Long, tmp As String
    JoinData = ""
    tmp = "|"
    For Each Rng In sRng
      For Each Cel In Rng
        Res = Cel.Value
        If TypeName(Res) <> "Error" Then
          If Len(Res) > 0 Then
            If NoDouble Then
              If InStr(1, tmp, "|" & Res & "|") = 0 Then
                k = k + 1
                If k = id Then JoinData = Res: Exit Function
                tmp = tmp & Res & "|"
              End If
            Else
              k = k + 1
              If k = id Then JoinData = Res: Exit Function
            End If
          End If
        End If
      Next
    Next
End Function
Nhấp chuột vào đây để mở rộng...
Cảm ơn ban @HieuCD rất nhiều
Quá chuẩn không cần chỉnh
Chúc bạn cuối tuần vui vui nhiều bạn nhé!
 
Upvote 0
Bạn phải đăng nhập hoặc đăng ký để trả lời bài viết tại đây.

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

V
Quản lý xuất nhập vật tư trong kho
Trả lời
12
Đọc
397
Vũ Hải Sơn
V
ongke0711
  • Question Question
Tải hóa đơn điện tử (https://hoadondientu.gdt.gov.vn/) Excel Vba (1 người xem)
    • Thích
    • Yêu thích
    • Cảm ơn
3 4 5
Trả lời
427
Đọc
56K
ongke0711
ongke0711
N
Nhờ giúp Drop down list theo tỉnh xã mới.
Trả lời
3
Đọc
94
HUONGHCKT
H
H
  • Question Question
Dò tìm giá trị từ bảng khác theo cột
Trả lời
6
Đọc
259
Chả_biết_gì
C
2
  • Question Question
Hỏi cách in phiếu điều tra PCGD-XMC từ file dữ liệu mẫu xuất ra từ hệ thống PCGD-XMC của Bộ GD
    • Thích
Trả lời
26
Đọc
1K
haitien123
H
ongke0711
Truy cập trang GPE chậm
    • Thích
Trả lời
3
Đọc
141
Hai Lúa Miền Tây
Hai Lúa Miền Tây
N
Định mức nguyên vật liệu
Trả lời
48
Đọc
5K
ptm0412
ptm0412
V
Gộp File Từng File Excel vào 1 File
Trả lời
16
Đọc
399
ptm0412
ptm0412
Gà Con yêu VBA
Mở Pass file excel phiên bản .xlsx , xlsm, xlsb
Trả lời
10
Đọc
725
Zizi One
Zizi One
I
Phân bổ số lượng xuất kho trong kỳ theo từng mã nguyên vật liệu
Trả lời
6
Đọc
166
IrisQ
I
L
Các bạn giúp mình hoàn thiện công thức hàm sumif nhé
Trả lời
5
Đọc
132
lequang_qn
L
N
Xin file tính khẩu phần ăn cho trường mầm non
Trả lời
5
Đọc
6K
HUONGHCKT
H
Gà Công Nghệ
Cập nhật dữ liệu từ sheet này sang sheet khác
Trả lời
14
Đọc
266
HUONGHCKT
H
queluatb
Tự động tăng số hóa đơn theo điều kiện
Trả lời
4
Đọc
165
queluatb
queluatb
HeSanbi
  • Đã giải quyết
VBA_FastCode v2.22 - Công cụ học và viết mã VBA một cách nhanh nhất (*27/10/2023)
    • Thích
    • Yêu thích
    • Cảm ơn
Trả lời
53
Đọc
18K
sutu
S
hung2412
Nhờ giúp Lấy sao kê giao dịch từ Trang Web BIDV bằng VBA
Trả lời
6
Đọc
259
ongke0711
ongke0711
N
Tạo COM Add-In bằng Visual C++
    • Thích
Trả lời
15
Đọc
1K
Tuanba1992
Tuanba1992
T
Kính nhờ Anh chị hỗ trợ giúp e công thức giúp e với ạ! (1 người xem)
Trả lời
3
Đọc
86
IrisQ
I
L
Hàm nối ký tự trong 1 cell khi trong cell các ký tự xuống dòng
Trả lời
2
Đọc
130
HieuCD
H
J
Xử lý các file Excel bị nặng sau nhiều năm sử dụng
Trả lời
19
Đọc
2K
Hà Tiềm
H
Xem thêm…

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

Thời gian đếm ngược.

000
Ngày
00
Giờ
00
phút
00
giây
Thân mời tham dự sự kiện sinh nhật GPE 2025
Back
Top Bottom