Xin hàm xắp xếp dữ liệu của bảng vào cột hoặc hàng

Liên hệ QC
N

nvh611

Thành viên thường trực
Tham gia
20/5/17
Bài viết
228
Được thích
42
Nhờ các bạn trên diễn đàn viết giúp hàm như file đính kèm
 

File đính kèm

  • CT_ Hàm xắp xếp dữ liệu của bảng vào cột hoặc hàng.xlsb
    8.4 KB · Đọc: 11
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

  • CT_ Hàm xắp xếp dữ liệu của bảng vào cột hoặc hàng.xlsb
    14.6 KB · Đọc: 7
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

  • Copy of CT_ Hàm xắp xếp dữ liệu của bảng vào cột hoặc hàng.xlsb
    14.5 KB · Đọc: 8
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

  • Copy of CT_ Hàm xắp xếp dữ liệu của bảng vào cột hoặc hàng.xlsb
    14.9 KB · Đọc: 8
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

  • Copy of CT_ Hàm xắp xếp dữ liệu của bảng vào cột hoặc hàng.xlsb
    14.7 KB · Đọc: 7
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
Bạn phải đăng nhập hoặc đăng ký để trả lời bài viết tại đây.
Web KT

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

A
Excel thiếu dữ liệu
Trả lời
4
Đọc
103
Mr.hieudoanxd
Mr.hieudoanxd
H
  • Question
Code subtotal và tìm điều kiện
Trả lời
11
Đọc
193
Hoàng Tuấn 868
H
S
Nhờ giúp đỡ code in toàn bộ danh sách có điều kiện
Trả lời
1
Đọc
47
BuiQuangThuan
B
A
Đếm dữ liệu với điều kiện
Trả lời
11
Đọc
108
DeTong
D
Maika8008
  • Question
Add-In .xlam trộn dữ liệu Excel vào Word
    • Thích
    • Yêu thích
    • Cảm ơn
2
Trả lời
29
Đọc
2K
vu_tuan_manh_linh
vu_tuan_manh_linh
Xem thêm…

Facebook

Giaiphapexcel.com

Group

DIỄN ĐÀN GIẢI PHÁP EXCEL Group 1
DIỄN ĐÀN GIẢI PHÁP EXCEL Group 2

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

Back
Top Bottom