Các câu hỏi về mảng trong VBA (Array)

Liên hệ QC

viehoai

Thành viên gắn bó
Tham gia
22/5/09
Bài viết
2,600
Được thích
2,907
Xin các anh chị giúp đỡ Code Gán các giá trị của một Range là các phần tử của Mãng
Ví dụ: Tôi có các giá trị của Range("A1:A10"). Tôi muốn viết code để gán giá trị của các cells từ A1:A10 là các phần tử của Mãng Arr chẳn hạn.
Xin cảm ơn các anh chị
 
Buồn buồn làm chơi:
Mã:
Option Explicit
Sub test()
Dim k&, count&, cell As Range, arr(), rng As Range
Set rng = Worksheets("Sheet1").Range("A3:F3")
count = WorksheetFunction.CountIf(rng, "o")
    If count = 0 Then
        MsgBox "Danh sach rong"
        Exit Sub
    End If
ReDim arr(1 To count, 1 To 2)
    For Each cell In rng
        If cell.Value = "o" Then
            k = k + 1
            arr(k, 1) = cell.Offset(-2, 0).Value
            arr(k, 2) = cell.Offset(-1, 0).Value
        End If
    Next
Worksheets("Sheet2").Range("A2").Resize(k, 2).Value = arr
End Sub
ui, chạy ngọt xớt luôn ạ. Em cám ơn anh nhiều nhiều.
cho em hỏi thêm 1 xíu nữa, nếu giờ em muốn xuất ra 2 msgbox( msgbox1: "danh sách quả gồm :" & {giá trị của mảng arr(k,1)} và msgbox2: "danh sách người gồm :" & {giá trị của mảng arr(k,2)} ).
Câu hỏi của em hơi ngốc nghếch, mong anh chỉ cho để hiểu rõ thêm ạ.
 
Upvote 0
ui, chạy ngọt xớt luôn ạ. Em cám ơn anh nhiều nhiều.
cho em hỏi thêm 1 xíu nữa, nếu giờ em muốn xuất ra 2 msgbox( msgbox1: "danh sách quả gồm :" & {giá trị của mảng arr(k,1)} và msgbox2: "danh sách người gồm :" & {giá trị của mảng arr(k,2)} ).
Câu hỏi của em hơi ngốc nghếch, mong anh chỉ cho để hiểu rõ thêm ạ.
Msgbox xuất ra tiếng Việt không đúng: mận = m?n nên chịu khó nhé:
PHP:
Option Explicit
Sub test()
Dim i&, k&, arr(), rng, qua As String, ten As String
rng = Worksheets("Sheet1").Range("A1:F3").Value
ReDim arr(1 To 6, 1 To 2)
    For i = 1 To 6
        If rng(3, i) = "o" Then
            k = k + 1
            Select Case k
                Case Is = 1
                    qua = "Danh sach qua gom: " & rng(1, i)
                    ten = "Danh sach ten gom: " & rng(2, i)
                Case Else
                    qua = qua & ", " & rng(1, i)
                    ten = ten & ", " & rng(2, i)
            End Select
            arr(k, 1) = rng(1, i)
            arr(k, 2) = rng(2, i)
        End If
    Next
Worksheets("Sheet2").Range("A2").Resize(k, 2).Value = arr
MsgBox qua & vbLf & ten
End Sub
 
Upvote 0
Muốn code array thì căn bản để học như vầy:

1. Code làm trực tiếp với mảng
code sử dụng:
- kỹ thuật chép range qua mảng
- kỹ thuật chép mảng trở lại range, với giới hạn số dòng, số cột.
- kỹ thuật chuyển cột thành dòng, và dòng thành cột.

Mã:
Sub S1()
' sub copy một bảng dữ liệu (hàng ngang) và tách ra hai bảng hàng dọc tùy theo x/o
' lưu ý: vì đầu vào hàng ngang và đầu ra hàng dọc nên cột copy thành dòng và ngược lại
' lưu ý 2: code tôi viết theo kiểu lười biếng, không khai báo biến, và dùng [ ] để tham chiếu range. Kiểu tham chiếu này viết nhanh nhưng tínCode sử dụng h chậm.
a = Sheet1.[a1].CurrentRegion.Value ' chuyển dữ liệu cần thiết vào mảng
ReDim b1(1 To UBound(a, 2), 1 To UBound(a, 1)) ' định dạng mảng đầu ra
ReDim b2(1 To UBound(a, 2), 1 To UBound(a, 1))
For i = 1 To UBound(a, 2) ' duyệt mang đàu vào theo hàng ngang
    ' r1 là số dòng mảng b1, r2 là số dòng mảng b2
    Select Case a(3, i)
    Case "x" ' chép vào bảng x theo hàng dọc
        r1 = r1 + 1
        b1(r1, 1) = a(1, i)
        b1(r1, 2) = a(2, i)
    Case "o" ' chép vào bảng o theo hàng dọc
        r2 = r2 + 1
        b2(r2, 1) = a(1, i)
        b2(r2, 2) = a(2, i)
    End Select
Next i
If r1 > 0 Then
    Sheet2.[a1].Resize(r1, 2) = b1 ' chép lại sheet2
Else
    MsgBox "Khong co dong x nao ca"
End If
If r2 > 0 Then
    Sheet2.[e1].Resize(r2, 2) = b2 ' chép lại sheets
Else
    MsgBox "Khong co dong 0 nao ca"
End If
End Sub

2. Code cải tiến một chút:
Code sử dụng:
- Kỹ thuật chép range qua mảng, có transpose
- Kỹ thuật ghi mảng đầu ra ngay chỗ mảng đầu vào

Mã:
Sub S2()
' sub copy một bảng dữ liệu (hàng ngang) và tách ra hai bảng hàng dọc tùy theo x/o
' lưu ý: vì code chuyển đầu vào từ hàng ngang thảnh dọc cho nên cứ duyệt và chép thẳng thừng
' lưu ý 2: code tôi viết theo kiểu lười biếng, không khai báo biến, và dùng [ ] để tham chiếu range.
a = Application.Transpose(Sheet1.[a1].CurrentRegion)
ReDim b(1 To UBound(a, 1), 1 To UBound(a, 2)) ' định dạng mảng thứ hai của đầu ra, mảng thứ nhất thì dùng lại mảng đầu vào.
For i = 1 To UBound(a, 1)
    Select Case a(i, 3)
    Case "x"
        r1 = r1 + 1
        a(r1, 1) = a(i, 1)
        a(r1, 2) = a(i, 2)
    Case "o"
        r2 = r2 + 1
        b(r2, 1) = a(i, 1)
        b(r2, 2) = a(1, 1)
    End Select
Next i
If r1 > 0 Then
    Sheet2.[a1].Resize(r1, 2) = a ' chép lại sheet2
Else
    MsgBox "Khong co dong x nao ca"
End If
If r2 > 0 Then
    Sheet2.[e1].Resize(r2, 2) = b ' chép lại sheet2
Else
    MsgBox "Khong co dong 0 nao ca"
End If
End Sub

Tôi không buồn viết code tóm lược như yêu cầu bài #1524. Vì đó không phải là kỹ thuật mảng mà thớt bảo rằng mình muốn học như bào #1522 đã nói. Mặt khác, tôi không khuyến khích chuyện "thêm nữa", được voi đòi tiên.
 
Upvote 0
Msgbox xuất ra tiếng Việt không đúng: mận = m?n nên chịu khó nhé:
PHP:
Option Explicit
Sub test()
Dim i&, k&, arr(), rng, qua As String, ten As String
rng = Worksheets("Sheet1").Range("A1:F3").Value
ReDim arr(1 To 6, 1 To 2)
    For i = 1 To 6
        If rng(3, i) = "o" Then
            k = k + 1
            Select Case k
                Case Is = 1
                    qua = "Danh sach qua gom: " & rng(1, i)
                    ten = "Danh sach ten gom: " & rng(2, i)
                Case Else
                    qua = qua & ", " & rng(1, i)
                    ten = ten & ", " & rng(2, i)
            End Select
            arr(k, 1) = rng(1, i)
            arr(k, 2) = rng(2, i)
        End If
    Next
Worksheets("Sheet2").Range("A2").Resize(k, 2).Value = arr
MsgBox qua & vbLf & ten
End Sub
Em cám ơn anh nhiều ạ. Nhưng hình như thiếu mất điều kiện rồi ạ. hì
mạn phép thêm vào code của anh như sau có hợp lý không ạ:
Mã:
Option Explicit
Sub test()
Dim count&, i&, k&, arr(), rng, qua As String, ten As String
rng = Worksheets("Sheet1").Range("A1:F3").Value

Dim rng1 As Range
Set rng1 = Worksheets("Sheet1").Range("A3:F3")
count = WorksheetFunction.CountIf(rng1, "o")
    If count = 0 Then
        MsgBox "Danh sach rong"
        Exit Sub
    End If
ReDim arr(1 To 6, 1 To 2)
    For i = 1 To 6
        If rng(3, i) = "o" Then
            k = k + 1
            Select Case k
                Case Is = 1
                    qua = "Danh sach qua gom: " & rng(1, i)
                    ten = "Danh sach ten gom: " & rng(2, i)
                Case Else
                    qua = qua & ", " & rng(1, i)
                    ten = ten & ", " & rng(2, i)
            End Select
            arr(k, 1) = rng(1, i)
            arr(k, 2) = rng(2, i)
    
        End If
    Next
    
Worksheets("Sheet2").Range("A2").Resize(k, 2).Value = arr
MsgBox qua & vbLf & ten
End Sub
Bài đã được tự động gộp:

Muốn code array thì căn bản để học như vầy:

1. Code làm trực tiếp với mảng
code sử dụng:
- kỹ thuật chép range qua mảng
- kỹ thuật chép mảng trở lại range, với giới hạn số dòng, số cột.
- kỹ thuật chuyển cột thành dòng, và dòng thành cột.

Mã:
Sub S1()
' sub copy một bảng dữ liệu (hàng ngang) và tách ra hai bảng hàng dọc tùy theo x/o
' lưu ý: vì đầu vào hàng ngang và đầu ra hàng dọc nên cột copy thành dòng và ngược lại
' lưu ý 2: code tôi viết theo kiểu lười biếng, không khai báo biến, và dùng [ ] để tham chiếu range. Kiểu tham chiếu này viết nhanh nhưng tínCode sử dụng h chậm.
a = Sheet1.[a1].CurrentRegion.Value ' chuyển dữ liệu cần thiết vào mảng
ReDim b1(1 To UBound(a, 2), 1 To UBound(a, 1)) ' định dạng mảng đầu ra
ReDim b2(1 To UBound(a, 2), 1 To UBound(a, 1))
For i = 1 To UBound(a, 2) ' duyệt mang đàu vào theo hàng ngang
    ' r1 là số dòng mảng b1, r2 là số dòng mảng b2
    Select Case a(3, i)
    Case "x" ' chép vào bảng x theo hàng dọc
        r1 = r1 + 1
        b1(r1, 1) = a(1, i)
        b1(r1, 2) = a(2, i)
    Case "o" ' chép vào bảng o theo hàng dọc
        r2 = r2 + 1
        b2(r2, 1) = a(1, i)
        b2(r2, 2) = a(2, i)
    End Select
Next i
If r1 > 0 Then
    Sheet2.[a1].Resize(r1, 2) = b1 ' chép lại sheet2
Else
    MsgBox "Khong co dong x nao ca"
End If
If r2 > 0 Then
    Sheet2.[e1].Resize(r2, 2) = b2 ' chép lại sheets
Else
    MsgBox "Khong co dong 0 nao ca"
End If
End Sub

2. Code cải tiến một chút:
Code sử dụng:
- Kỹ thuật chép range qua mảng, có transpose
- Kỹ thuật ghi mảng đầu ra ngay chỗ mảng đầu vào

Mã:
Sub S2()
' sub copy một bảng dữ liệu (hàng ngang) và tách ra hai bảng hàng dọc tùy theo x/o
' lưu ý: vì code chuyển đầu vào từ hàng ngang thảnh dọc cho nên cứ duyệt và chép thẳng thừng
' lưu ý 2: code tôi viết theo kiểu lười biếng, không khai báo biến, và dùng [ ] để tham chiếu range.
a = Application.Transpose(Sheet1.[a1].CurrentRegion)
ReDim b(1 To UBound(a, 1), 1 To UBound(a, 2)) ' định dạng mảng thứ hai của đầu ra, mảng thứ nhất thì dùng lại mảng đầu vào.
For i = 1 To UBound(a, 1)
    Select Case a(i, 3)
    Case "x"
        r1 = r1 + 1
        a(r1, 1) = a(i, 1)
        a(r1, 2) = a(i, 2)
    Case "o"
        r2 = r2 + 1
        b(r2, 1) = a(i, 1)
        b(r2, 2) = a(1, 1)
    End Select
Next i
If r1 > 0 Then
    Sheet2.[a1].Resize(r1, 2) = a ' chép lại sheet2
Else
    MsgBox "Khong co dong x nao ca"
End If
If r2 > 0 Then
    Sheet2.[e1].Resize(r2, 2) = b ' chép lại sheet2
Else
    MsgBox "Khong co dong 0 nao ca"
End If
End Sub

Tôi không buồn viết code tóm lược như yêu cầu bài #1524. Vì đó không phải là kỹ thuật mảng mà thớt bảo rằng mình muốn học như bào #1522 đã nói. Mặt khác, tôi không khuyến khích chuyện "thêm nữa", được voi đòi tiên.
Em cám ơn anh VetMini nhiều ạ, mong được học nhiều điều hơn nữa từ các anh ạ.
 
Lần chỉnh sửa cuối:
Upvote 1
Mình không biết gì về VBA nên nhờ AE viết hộ giúp đoạn này :
Mình muốn chọn nhân 1 hoặc nhân 2 hoặc nhân 3 số lượng của cột B lên nếu số lượng tại ô đó lớn hơn 0.
Ví dụ : Bạn muốn nhân số lượng lên mấy lần ? Rồi mình chọn nhân 2 thì số lượng nhân 2 và trả về thông báo "Đã nhân 2".
Thanks ạ
 
Upvote 0
Mình không biết gì về VBA nên nhờ AE viết hộ giúp đoạn này :
Mình muốn chọn nhân 1 hoặc nhân 2 hoặc nhân 3 số lượng của cột B lên nếu số lượng tại ô đó lớn hơn 0.
Ví dụ : Bạn muốn nhân số lượng lên mấy lần ? Rồi mình chọn nhân 2 thì số lượng nhân 2 và trả về thông báo "Đã nhân 2".
....
Bạn có biết đọc tiếng Việt hôn?
Vấn đề của bạn kiên quan gì đến "mảng", chủ đề của thớt này?

Bớt bồi Tây chút đi.
 
Upvote 0
Làm vầy nè:
Mã:
Function BigRange(ByVal SrcRng As Range) As Range
  Set BigRange = Range(Replace(SrcRng.Address, ",", ":"))
End Function
Sub Taomang2()
  Dim SRng As Range, eRng As Range
  Dim Rng As Range, hang As Long, Cot As Long
  Dim sArr
  With Sheet1
    Set SRng = .Range("A6:A18"): Set eRng = .Range("C6:C18")
    Set Rng = BigRange(.Range(SRng, eRng))
    sArr = Rng.Value
    hang = UBound(sArr, 1): Cot = UBound(sArr, 2)
    .Range("I6").Resize(hang, Cot) = sArr
  End With
End Sub
Trong trường hợp Rng của em nằm ở trong 2 sheet khác nhau em phải sửa lại như nào ạ
 
Upvote 0
Người ta tự dưng im bặt đương nhiên là phải có lý do quan trọng.
Tuy nhiên, mình nên trọng người ta mà được bao giờ thắc mắc các lý do ấy.

Hiện tại diễn đàng cũng đang có nhân vật giỏi không kém. Và cũng rất sẵn sàng giải quyết vấn đề của mọi người. Nghe nói tên tuổi "trong và ngoài nước đều biết tới"
 
Upvote 0
Nhờ anh chị code giúp:
Em muốn lọc lấy giữ liệu ở 2 ô theo các điều kiện khác nhau như lấy các tên trùng nhau trong 2 ô hoặc tên chỉ xuất hiện trong 1 ô như ảnh đính kèm.( e ko biết up file đính kèm ở chỗ nào mong anh chị bỏ qua dùng tạm bằng ảnh)
Tự mày mò nhưng nhiều cái khó hiểu nên mong anh chị giúp đỡ.Em cảm ơn anh chị nhiều ạ.
IMG_20230802_172605.jpg
 
Upvote 0
Đại số tập hợp:
- Điều kiện thứ nhất của bạn là phép Hội (Union)
- Điều kiện thứ hai của bạn phép Ngoại Bên Trái (Left Difference)
- Điều kiện thứ ba của bạn phép Ngoại Bên Phải (Roght Difference)
- Điều kiện thứ nhất của bạn là phép Giao (Intersection)

1. Dùng hàm Split để tách A2 và A4 ra thành 2 mảng a2 và a4.
2. Vòng lặp duyệt qua các phần tử của a2:
2.1. Dùng Application.Match(a2(i), a(4), 0) để tìm phần tử này trong a4
2.1.1. Nếu ra Error thì ghi vào danh sách Ngoại Bên Trái
2.1.2. Nếu ra một số n thì:
2.1.2.1. Ghi vào danh sách Giao
2.1.2.2 Xóa phần tử a4(n)
3. Sau khi chạy xong vòng lặp thì những gì còn lại trong a4 sẽ ghi vào Ngoại Bên phải
4. Ngoại Bên Trái & Giao & Ngoại Bên Phải = Hội
 
Upvote 0
Nhờ anh chị code giúp:
Em muốn lọc lấy giữ liệu ở 2 ô theo các điều kiện khác nhau như lấy các tên trùng nhau trong 2 ô hoặc tên chỉ xuất hiện trong 1 ô như ảnh đính kèm.( e ko biết up file đính kèm ở chỗ nào mong anh chị bỏ qua dùng tạm bằng ảnh)
Tự mày mò nhưng nhiều cái khó hiểu nên mong anh chị giúp đỡ.Em cảm ơn anh chị nhiều ạ.
Theo gợi ý của bạn @VetMini tạo cho bạn hàm tự tạo "5 trong 1"
Mã:
Function LocChuoi(str, str2, Optional ByVal loai& = 0, Optional ByVal deli$ = ",")
'loai = 1: Co trong chuoi str khong co trong chuoi str2
'loai = 2: Co trong chuoi str2 khong co trong chuoi str
'loai = 3: Co trong chuoi str va Co trong chuoi str2
'loai = 4: Co trong chuoi str hoac str2
'loai < 1 hoac loai > 4 hoac khong khai bao: LocChuoi = mang 1 chieu có 4 ket qua
Dim S, res$(1 To 4), i&, t$
  S = Split(str, deli)
  str2 = deli & str2 & deli
  res(2) = str2
  For i = 0 To UBound(S)
    t = deli & S(i)
    res(4) = res(4) & t
    If InStr(1, str2, t & deli) = 0 Then
      res(1) = res(1) & t
    Else
      res(2) = Replace(res(2), t & deli, deli)
      res(3) = res(3) & t
    End If
  Next i
  res(1) = Mid(res(1), 2)
  res(2) = IIf(res(2) <> deli, Mid(res(2), 2, Len(res(2)) - 2), "")
  res(3) = Mid(res(3), 2)
  res(4) = IIf(Len(res(4)), Mid(res(4), 2) & deli, "") & res(2)
  If loai < 1 Or loai > 4 Then
    LocChuoi = res
  Else
    LocChuoi = res(loai)
  End If
End Function
Công thức ngoài sheet
Mã:
=LocChuoi(A2,A4,1)
=LocChuoi(A2,A4,2)
=LocChuoi(A2,A4,3)
=LocChuoi(A2,A4,4)
Công thức trả về mảng 4 kết quả
Mã:
=LocChuoi(A2,A4)
 
Upvote 0
Đại số tập hợp:
- Điều kiện thứ nhất của bạn là phép Hội (Union)
- Điều kiện thứ nhất của bạn là phép Giao (Intersection)
Thời của bác học chắc vẫn dùng tên cũ
Sau này thời em học, thì gọi là "Giao" và "Hợp" (Không phải Giao và Hội). (Chắc là tân tiến hơn cho phù hợp thời đại)

:''":''":''"
 
Upvote 0
Thời của bác học chắc vẫn dùng tên cũ
Sau này thời em học, thì gọi là "Giao" và "Hợp" (Không phải Giao và Hội). (Chắc là tân tiến hơn cho phù hợp thời đại)...
Bạn lầm lộn rồi. Những tên ấy không hề thay đổi trong môn Đại Số.
Bạn đã lẫn với cái môn lề đường nào đó (có lẽ tên là Toán Đại Cú)
 
Upvote 0
Theo gợi ý của bạn @VetMini tạo cho bạn hàm tự tạo "5 trong 1"
Mã:
Function LocChuoi(str, str2, Optional ByVal loai& = 0, Optional ByVal deli$ = ",")
'loai = 1: Co trong chuoi str khong co trong chuoi str2
'loai = 2: Co trong chuoi str2 khong co trong chuoi str
'loai = 3: Co trong chuoi str va Co trong chuoi str2
'loai = 4: Co trong chuoi str hoac str2
'loai < 1 hoac loai > 4 hoac khong khai bao: LocChuoi = mang 1 chieu có 4 ket qua
Dim S, res$(1 To 4), i&, t$
  S = Split(str, deli)
  str2 = deli & str2 & deli
  res(2) = str2
  For i = 0 To UBound(S)
    t = deli & S(i)
    res(4) = res(4) & t
    If InStr(1, str2, t & deli) = 0 Then
      res(1) = res(1) & t
    Else
      res(2) = Replace(res(2), t & deli, deli)
      res(3) = res(3) & t
    End If
  Next i
  res(1) = Mid(res(1), 2)
  res(2) = IIf(res(2) <> deli, Mid(res(2), 2, Len(res(2)) - 2), "")
  res(3) = Mid(res(3), 2)
  res(4) = IIf(Len(res(4)), Mid(res(4), 2) & deli, "") & res(2)
  If loai < 1 Or loai > 4 Then
    LocChuoi = res
  Else
    LocChuoi = res(loai)
  End If
End Function
Công thức ngoài sheet
Mã:
=LocChuoi(A2,A4,1)
=LocChuoi(A2,A4,2)
=LocChuoi(A2,A4,3)
=LocChuoi(A2,A4,4)
Công thức trả về mảng 4 kết quả
Mã:
=LocChuoi(A2,A4)
Theo gợi ý của bạn @VetMini tạo cho bạn hàm tự tạo "5 trong 1"
Mã:
Function LocChuoi(str, str2, Optional ByVal loai& = 0, Optional ByVal deli$ = ",")
'loai = 1: Co trong chuoi str khong co trong chuoi str2
'loai = 2: Co trong chuoi str2 khong co trong chuoi str
'loai = 3: Co trong chuoi str va Co trong chuoi str2
'loai = 4: Co trong chuoi str hoac str2
'loai < 1 hoac loai > 4 hoac khong khai bao: LocChuoi = mang 1 chieu có 4 ket qua
Dim S, res$(1 To 4), i&, t$
  S = Split(str, deli)
  str2 = deli & str2 & deli
  res(2) = str2
  For i = 0 To UBound(S)
    t = deli & S(i)
    res(4) = res(4) & t
    If InStr(1, str2, t & deli) = 0 Then
      res(1) = res(1) & t
    Else
      res(2) = Replace(res(2), t & deli, deli)
      res(3) = res(3) & t
    End If
  Next i
  res(1) = Mid(res(1), 2)
  res(2) = IIf(res(2) <> deli, Mid(res(2), 2, Len(res(2)) - 2), "")
  res(3) = Mid(res(3), 2)
  res(4) = IIf(Len(res(4)), Mid(res(4), 2) & deli, "") & res(2)
  If loai < 1 Or loai > 4 Then
    LocChuoi = res
  Else
    LocChuoi = res(loai)
  End If
End Function
Công thức ngoài sheet
Mã:
=LocChuoi(A2,A4,1)
=LocChuoi(A2,A4,2)
=LocChuoi(A2,A4,3)
=LocChuoi(A2,A4,4)
Công thức trả về mảng 4 kết quả
Mã:
=LocChuoi(A2,A4)
Chuẩn quá ạ!
Em xin cảm ơn các anh, chị, thầy cô trong diễn đàn GPE đã giúp đỡ ạ. Đặc biệt cảm ơn anh @HieuCD đã code giúp em từ các ý của anh
@VetMini ạ, chứ không với trình độ gà mờ của em thì cũng không thể hiểu và làm được như này ạ. Một lần nữa xin được cảm ơn các anh chị!
 
Upvote 0
Thời mình phổ thông gọi là giao và hội, lên đại học gọi là giao và hợp. Bọn mình đùa nhau các Thầy cô cố tình hợp thức hóa từ nhạy cảm, bình thường dùng từ nầy có khả năng lên thớt cho các thành viên tiên tiến của đoàn hội kiểm điểm
Toán logic dùng "tuyển" và "hợp" , các phép tính phủ định nuốt dể mắc nghẹn
 
Upvote 0
Đây là thớt về mảng cho nên tôi thêm bài này. Mục đích dùng mảng thật nhiều chứ khong luận đến hiệu quả (như tốc độ, code dễ xem dễ sửa)

Mã:
Function FMatches(ByVal s1, ByVal s2) As Variant
' compares 2 comma-delimited strings
' return an array (1 To 4):
' 1: intersection; 2: union; 3: left diff; 4: right diff
  a1 = Split(s1, ",")
  a2 = Split(s2, ",")
  ReDim a3(0 To UBound(a1)) As String ' intersection
  i3 = -1
  For Each e In Split(s1, ",")
    If UBound(Filter(a2, e)) >= 0 Then
    ' found e in a2 => a2 contains e
    ' now we insert e in the intersection set (a3)
    ' and take e off a1, a2
      i3 = i3 + 1
      a3(i3) = e ' intersection
      a1 = Filter(a1, e, False)
      a2 = Filter(a2, e, False)
      If UBound(a2) < 0 Then Exit For ' a2 exhausted
    End If
  Next e
  If i3 >= 0 Then ReDim Preserve a3(0 To i3)
  ReDim a(1 To 4) As String
  a(1) = Join(a3, ",") ' intersection
  a(3) = Join(a1, ",") ' left diff
  a(4) = Join(a2, ",") ' right diff
  a(2) = a(3) & IIf(a(3) <> "" And a(1) <> "", ",", "") & a(1) ' union
  a(2) = a(2) & IIf(a(2) <> "" And a(4) <> "", ",", "") & a(4)
  FMatches = a
End Function
 
Lần chỉnh sửa cuối:
Upvote 0
Chào anh em. Mình có search trên mạng nhưng vẫn chưa rõ lắm. Mong anh em chỉ giáo giúp mình. Ý là mình có một bảng rất nhiều cột thông tin. Nhưng chỉ xử lý trên vài cột nhất định ví dụ là A,B,C, F, H. mình muốn đưa các giá trị ở các cột này vào mảng để xử lý cho nhanh. Nhưng vì các cột không liên tục nên mình không biết khai báo và nhập dữ liệu vào bảng như thế nào. rồi khi gán trở lại cũng không biết luôn. Mong anh em chỉ giáo thêm. Chân thành cảm ơn
 
Upvote 0
Web KT
Back
Top Bottom