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

[viehoai]

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ị

 

[ndu96081631]

Nhờ các anh chị giúp em giải quyết bài toán này ( em có kèm file)
Em có dùng hàm if(and( nhưng chỉ dùng được có 7 lần….. vì em là thanh viên mới nên không biết tìm bài giải của các anh chị ở đâu trên diễn đàn nữa, vui lòng gửi bài giúp em qua mail :quachcongluanadong@gmail.com ( và chỉ giúp em cách tìm bài được đăng ở đâu luôn các anh chị nhé…..để lần sau tự em tìm. Thanks!

Nếu A6> 0 thì AG6=4 nếu A6<1 thì AG6=5
Nếu A6>0, B6<1thì AH6=5, nếu A6<1,B6<1 thì AH6=7, nếu B6>0 thì AH6=4
Nếu A6<1,B6<1,C6<1 thì AI6=10, nếu A6>0,B6<1,C6<1 thì AI6=7, nếu B6>0,C6<1 thì AI6=5, nếu C6>0 thi AI6=4
Tương tự ……
Nếu A6<1,B6<1,C6<1……..AD6<1 thì Bj6=3000, nếu A6>0,B6<1,C6<1……..AD6<1 thì BJ6=2900, nếu B6>0,C6<1,D6<1……..AD6<1 thì BJ6=2700,nếu C6>0,D6<1,E6<1,F6<1……..AD6<1 thì BJ6=2500,
neu D6>0,E6<1,F6<1G6<1……..AD6<1 thì BJ6=2000, điều kiện tương tự như vậy đến khi AD>0 thì BJ6=4.
Nếu từ A6 đến AE6 đều <1 thì AG6=4 và lập lại điều kiện như trên

Đây là box lập trình, bộ bạn muốn giải quyết bài toán bằng phương pháp lập trình sao mà gửi bài vào đây

 

[siwtom]

Uh hen, lâu lâu bị "tẩu hỏa nhập ma", lập đi lập lại thành thói quen, giờ cái cơ bản lại không nhớ! Cám ơn Thầy nha.

Hoặc Dim sau đó ReDim hoặc

Sub FillArray()
    Dim MyRng As Range, n As Long, i As Long
    Set MyRng = Range(Source.[A2], Source.[A100].End(xlUp))
    n = MyRng.Rows.Count - 1
    [COLOR=#ff0000]Re[/COLOR]Dim ArrKhoiLuong(n) As String
    For i = 0 To n
        ArrKhoiLuong(i) = MyRng(i + 1).Value
    Next
End Sub

 

[Tường_Vi]

Thì 14 đúng rồi!
Arr(0) = Array(Array(4, 5, 6), Array(7, 8, 9), Array(10, 11, 12))
Arr(1) = Array(4, Array(13, 14, 15), 6)
===>
Arr(1)(0) = 4
Arr(1)(1) = Array(13, 14, 15)
Arr(1)(2) = 6
===>
Arr(1)(1)(0) = 13
Arr(1)(1)(1) = 14
Arr(1)(1)(2) = 15
-------------
Đương nhiên kết quả trên dựa trên Option Base 0. Nếu là Option Base 1 thì kết quả sẽ khác

He he...
Trong mảng lại có mảng, Hay quá...e hiểu rồi, lại hiểu thêm một tí tẹo về mảng rồi

 

[hoangvuluan]

Hàm kết nối/phân tách mảng chuỗi

Với mục đích tìm hiểu, học hỏi về dữ liệu kiểu Array, tôi có xây dựng 2 hàm:

1. Function JointStr(ar As Variant, Optional jS As String = " ") As String

Hàm này cho phép nối chuỗi có trong 1 Range (1 vùng), trong một Array (2 chiều, 1 chiều: dọc/ngang) thành một chuỗi với chuỗi phân tách tùy chọn:
Ví dụ: = JoinStr({1, 2, 3}, "->") sẽ cho kết quả là: 1->2->3
hoặc các dạng vùng = JointStr("A1:C5"); JointStr("A1:A5"); JointStr("A1:C1") ... chuỗi phân cách tuỳ chọn.

Function JointStr(ar As Variant, Optional jS As String = " ") As String
Dim vStr As String, Item
    Application.Volatile
    For Each Item In ar
        vStr = vStr & jS & Item
    Next
    JointStr = Replace(vStr, jS, "", 1, 1)
End Function

2. Function SplitStr(str As String, Optional jS As String = " ") As Variant

Hàm này ngược với hàm trên.
Cho phép trả giá trị theo 1 hàng ngang hoặc 1 hàng dọc tuỳ người sử dụng.

Function SplitStr(str As String, Optional jS As String = " ") As Variant
Dim c As Range, iR As Long, vkq(), hkq, j As Long
    Application.Volatile
    On Error Resume Next
    Set c = Application.Caller
    iR = c.Rows.Count
    On Error GoTo 0
    hkq = Split(str, jS)
    If (iR > 1) Then
        ReDim vkq(1 To iR, 1 To 1)
        For j = 1 To iR
            vkq(j, 1) = hkq(j - 1)
        Next
        SplitStr = vkq
    Else
        SplitStr = hkq
    End If
End Function

3. Cuối cùng là một ứng dụng nhỏ kết hợp 2 hàm này với hàm REPT của Excel để giải bài toán:
Cho 2 cột dữ liệu, cột đầu là các giá trị thường, cột sau là tần suất tương ứng. Viết ra một cột chứa giá trị lặp lại của cột dữ liệu đầu với số dòng bằng tần suất của nó.

(Xem file đính kèm)
<> Là bài tập với mục đích học hỏi, rất mong ACE trên Giải Pháp E góp ý kiến!

 

[huuthang_bd]

Là bài tập với mục đích học hỏi, rất mong ACE trên Giải Pháp E góp ý kiến!

Tôi xin góp ý với bạn một chút.
1. Thông thường khi viết hàm nối chuỗi người ta sẽ viết để sao cho hàm có thể nối được từ nhiều vùng dữ liệu khác nhau. Hàm JointStr của bạn chỉ cho phép nối từ một vùng hoặc một mảng. Và, thường sẽ bỏ qua ô không có dữ liệu. Ví dụ, JoinStr({1, "", 3}, "->") kết quả 1->3
sẽ hay hơn kết quả 1->->3
2. Hàm SplitStr của bạn chỉ đúng khi số ô trong vùng công thức đúng bằng số phần tử của kết quả. Nếu ít hơn kết quả sẽ thiếu và nếu nhiều hơn sẽ bị lỗi.
3. Về bài toán mà bạn áp dụng, tôi thấy nếu dùng code thì chỉ cần một thủ tục đơn giản với hai vòng lặp là đủ. Hoặc dùng công thức cũng được.

 

[hoangvuluan]

Tôi xin góp ý với bạn một chút.
1. Thông thường khi viết hàm nối chuỗi người ta sẽ viết để sao cho hàm có thể nối được từ nhiều vùng dữ liệu khác nhau. Hàm JointStr của bạn chỉ cho phép nối từ một vùng hoặc một mảng. Và, thường sẽ bỏ qua ô không có dữ liệu. Ví dụ, JoinStr({1, "", 3}, "->") kết quả 1->3
sẽ hay hơn kết quả 1->->3

Rất cảm ơn bạn đã góp ý.

Hàm JointStr có thể được cải tiến theo gợi ý của bạn như sau:

Function JointStr(jS As String, ParamArray ar() As Variant) As String
 Dim vStr As String, Item, iAr As Variant
     Application.Volatile
     For Each iAr In ar
     For Each Item In iAr
        If Item <> "" Then vStr = vStr & jS & Item
     Next
     Next
     JointStr = Replace(vStr, jS, "", 1, 1)
End Function

 

[hoangvuluan]

Tôi xin góp ý với bạn một chút.
2. Hàm SplitStr của bạn chỉ đúng khi số ô trong vùng công thức đúng bằng số phần tử của kết quả. Nếu ít hơn kết quả sẽ thiếu và nếu nhiều hơn sẽ bị lỗi.

Bạn kiểm tra giúp hàm SplitStr sau khi sửa lỗi:

Function SplitStr(str As String, Optional jS As String = " ") As Variant
Dim c As Range, iR As Long, iC As Long, vkq(), hkq, j As Long, m As Long
    Application.Volatile
    On Error Resume Next
    Set c = Application.Caller
    iR = c.Rows.Count
    iC = c.Columns.Count
    On Error GoTo 0
    j = InStr(str, jS & jS)
    Do While j > 0
        str = Replace(str, jS & jS, jS)
        j = InStr(str, jS & jS)
    Loop
    hkq = Split(str, jS)
    m = UBound(hkq)
    If (iR > 1) Then
        ReDim vkq(1 To m + 1, 1 To 1)
        For j = 1 To m + 1
            vkq(j, 1) = hkq(j - 1)
        Next
    Else
        ReDim vkq(1 To 1, 1 To m + 1)
        For j = 1 To m + 1
            vkq(1, j) = hkq(j - 1)
        Next
    End If
    SplitStr = vkq
End Function

 

[ndu96081631]

Rất cảm ơn bạn đã góp ý.

Hàm JointStr có thể được cải tiến theo gợi ý của bạn như sau:

Function JointStr(jS As String, ParamArray ar() As Variant) As String
 Dim vStr As String, Item, iAr As Variant
     Application.Volatile
     For Each iAr In ar
     For Each Item In iAr
        If Item <> "" Then vStr = vStr & jS & Item
     Next
     Next
     JointStr = Replace(vStr, jS, "", 1, 1)
End Function

Hàm dạng này tôi viết cũng khá lâu... Nó như vầy:

Function JoinText(ByVal Sep As String, ByVal IgnoreBlanks As Boolean, ParamArray sArray()) As String
  Dim tmpArr, SubArr, Arr(), Item, n As Long
  On Error Resume Next
  For Each SubArr In sArray
    tmpArr = SubArr
    If TypeName(tmpArr) <> "Variant()" Then
      If IgnoreBlanks = False Or Len(Trim(CStr(tmpArr))) > 0 Then
        n = n + 1
        ReDim Preserve Arr(1 To n)
        Arr(n) = CStr(tmpArr)
      End If
    Else
      For Each Item In tmpArr
        If IgnoreBlanks = False Or Len(Trim(CStr(Item))) > 0 Then
          n = n + 1
          ReDim Preserve Arr(1 To n)
          Arr(n) = CStr(Item)
        End If
      Next
    End If
  Next
  If n Then JoinText = Join(Arr, Sep)
End Function

- Nối chuổi từ mảng hoặc range (nhiều vùng hoặc 1 vùng)
- Bỏ qua chuổi rổng hay không là do người dùng quyết định
Bạn kiểm tra giúp với
--------------
Hàm của bạn vẫn còn vấn đề nếu dữ liệu đầu vào chỉ là 1 cell duy nhất

 

[hoangvuluan]

Function JoinText(ByVal Sep As String, ByVal IgnoreBlanks As Boolean, ParamArray sArray()) As String
'...'
End Function

Hàm của anh ndu rất tốt, tôi đã kiểm tra với nhiều trường hợp nhưng không phát hiện lỗi.
Cảm ơn đã reply!

(không hiểu sao với hàm JointStr thực hiện trên máy tính của tôi vẫn cho đúng kết quả khi đầu vào chỉ 1 ô duy nhất!)

 

[ndu96081631]

(không hiểu sao với hàm JointStr thực hiện trên máy tính của tôi vẫn cho đúng kết quả khi đầu vào chỉ 1 ô duy nhất!)

Sorry! Lúc nảy tôi test nhầm. Không phải lỗi xuất hiện khi dữ liệu đầu vào là 1 cell mà lỗi khi dữ liệu là 1 chuổi. Chẳng hạn =JointStr("-","a")
----------------

Xin hỏi về hàm SplitStr 1 tí: Sao phải cần đến hàm này trong khi VBA đã có sẵn hàm Split? Hay bạn muốn chuyển mảng 1 chiều thành 2 chiều chăng? (ngang thành dọc)

 

[hoangvuluan]

Sorry! Lúc nảy tôi test nhầm. Không phải lỗi xuất hiện khi dữ liệu đầu vào là 1 cell mà lỗi khi dữ liệu là 1 chuổi. Chẳng hạn =JointStr("-","a")
----------------

Xin hỏi về hàm SplitStr 1 tí: Sao phải cần đến hàm này trong khi VBA đã có sẵn hàm Split? Hay bạn muốn chuyển mảng 1 chiều thành 2 chiều chăng? (ngang thành dọc)

Vâng, thì cũng có 1 vài lý do để viết lại hàm Split. Quan trọng nhất là để mở rộng kiến thức. Vì theo tôi phương pháp tìm hiểu tốt nhất là cố gắng viết lại, xây dựng lại một số chức năng/ hàm mà ngôn ngữ lập trình đã có. Ngoài ra, lập trình cũng là một thú vui (mà cũng vì nó mà tôi "khổ sở" đến tận bây giờ!).

Thay đổi hàm khắc phục lỗi anh ndu đã phát hiện (thật là đi 1 ngày học được bao điều!):

Function JointStr(jS As String, ParamArray ar() As Variant) As String
 Dim vStr As String, Item, iAr As Variant
     Application.Volatile
     For Each iAr In ar
     If (TypeName(iAr) = "Variant()") Or (TypeName(iAr) = "Range") Or (TypeName(iAr) = "Array") Then
     For Each Item In iAr
        If Item <> "" Then vStr = vStr & jS & Item
     Next
     Else
        vStr = vStr & jS & iAr
     End If
     Next
     JointStr = Replace(vStr, jS, "", 1, 1)
End Function

 

[Tường_Vi]

dùng công thức mảng để so sánh 2 vùng dữ liệu???

Em đang học mảng và thử tìm hiểu cách dùng mảng để so sánh 2 vùng dữ liệu (so sánh sự khác nhau về số tiền hoặc ko tồn tại)

Anh, Chị giúp em nhé

 

[ndu96081631]

Em đang học mảng và thử tìm hiểu cách dùng mảng để so sánh 2 vùng dữ liệu (so sánh sự khác nhau về số tiền hoặc ko tồn tại)

Anh, Chị giúp em nhé

Cứ nói đến TỒN TẠI hoặc KHÔNG TỒN TẠI, ta nghĩ ngay đến Dictionary
Loại bài toán này đã nói nhiều lần rồi, chẳng hạn là ở đây:
http://www.giaiphapexcel.com/forum/showthread.php?48469-Tạo-hàm-so-sánh-2-danh-sách
Hàm ấy chỉ so sánh 1 điều kiện, giờ so sánh 2 điều kiện thì thuật toán cũng thế thôi (chỉnh lại 1 chút... Có thể nối chuổi 2 điều kiện lại với nhau rồi mới so sánh cũng là 1 cách)

 

[ALPHAA]

Các sư phụ ơi! chủ đề này mình thấy rất bổ ích nhưng nếu được thì chắc các sư phụ có thể tổng hợp lại thành một chuyên đề về mãng một cách xúc tích và cô đọng hơn đc ko ah! Vì hiện giờ mình cũng đang tập tành ứng dụng VBA (đặc biệt là chủ đề mãng này) để giải quyết cho công việc của mình sao cho code chạy lẹ và chính xác! Nếu được thì mình rất cám ơn các sư phụ nhiều lắm!

 

[Tường_Vi]

Em thử một đoạn code mảng này để làm công việc sau
Sheet có 11 cột và hơn 60.000 dòng dữ liệu
- Cột 5 : email
- Cột 7 : mobile
- Cột 10: City

Yêu cầu của Lãnh đạo theo thứ tự sau
1. Sort dữ liệu : Theo City
Sau đó
2. Sort dữ liệu : cùng city, vừa có email, vừa có di động
sau đó
3. Sort dữ liệu: Cùng city, chỉ có email, không có di động
sau đó
4. Sort dữ liệu: Cùng city, không email, có di động
cuối cùng
5. Sort dữ liệu: Cùng city, ko email, không di động

E đã tiến hành sort theo cột city trước (cột 10) rồi chạy đoạn code sau, nhưng nó bị lỗi
Nếu code chạy ok, em sẽ sort theo cột 11 là ổn
Chỉ giúp em

Sub Locthutu()
Dim Arr
Dim SArr
SArr = Sheet1.Range("A6:K60005").Value
ReDim Preserve Arr(1 To UBound(SArr, 1), 1 To 1)
For i = 2 To UBound(Arr)
    Arr(i, 1) = IIf(SArr(i, 10) = SArr(i - 1, 10), trim(SArr(i - 1, 10)), trim(SArr(i, 10)))
        
        If SArr(i, 5) <> "" And SArr(i, 7) <> "" Then ' have email & mobile
            Arr(i, 1) = Arr(i, 1) & "A" ' rank A
            If SArr(i, 5) <> "" And SArr(i, 7) = "" Then ' Just email only, No Mobile
                Arr(i, 1) = Arr(i, 1) & "B" ' rank B
                If SArr(i, 5) = "" And SArr(i, 7) <> "" Then ' No email, just Mobile
                      Arr(i, 1) = Arr(i, 1) & "C"
                      If SArr(i, 5) = "" And SArr(i, 7) = "" Then ' No email, No Mobile
                      Arr(i, 1) = Arr(i, 1) & "D"
                      End If
                End If
            End If
        End If
Next i
Sheet1.Range("K6:K60005").Value = Arr


End Sub

 

[Tường_Vi]

Em làm được rồi, bỏ Preserve đi là chạy (không hiểu sao lại thế nhỉ?)

Và Code sửa lại thành
phân cấp như sau
CityA: Có mail & di động
CityB: Có mail, ko di động
CityC: Ko mail, có di động
CityD: Ko mail, ko di động

Sub Locthutu()
Dim Arr
Dim SArr
SArr = Sheet1.Range("A6:K60005").Value
ReDim Preserve Arr(1 To UBound(SArr, 1), 1 To 1)
For i = 2 To UBound(Arr)
    Arr(i, 1) = IIf(SArr(i, 10) = SArr(i - 1, 10), trim(SArr(i - 1, 10)), trim(SArr(i, 10)))
        
        If SArr(i, 5) <> "" And SArr(i, 7) <> "" Then ' have email & mobile
            Arr(i, 1) = Arr(i, 1) & "A" ' rank A
            If SArr(i, 5) <> "" And SArr(i, 7) = "" Then ' Just email only, No Mobile
                Arr(i, 1) = Arr(i, 1) & "B" ' rank B
                If SArr(i, 5) = "" And SArr(i, 7) <> "" Then ' No email, just Mobile
                      Arr(i, 1) = Arr(i, 1) & "C"
                      If SArr(i, 5) = "" And SArr(i, 7) = "" Then ' No email, No Mobile
                      Arr(i, 1) = Arr(i, 1) & "D"
                      End If
                End If
            End If
        End If
Next i
Sheet1.Range("K6:K60005").Value = Arr


End Sub

Cuối cùng, sort cột thứ 11

 

[viehoai]

Từ bài viết [URL="http://www.giaiphapexcel.com/forum/showthread.php?27719-Ch%C6%B0%C6%A1ng-tr%C3%ACnh-ch%E1%BB%8Dn-th%C3%A9p-theo-di%E1%BB%87n-t%C3%ADch"]Chương trình chọn thép theo diện tích [/URL]nhưng chỉ tra được từng diện tích một, thông thường người ta có bảng tính diện tích cốt thép cho nhiều mặt cắt với nhiều cấu kiện khác nhau thì trường hợp này rất mất thời gian. Để khắc phục đều này tôi nghĩ ra phương án là tạo Validation gồm các phương án cho từng diện tích cốt thép để người sử dụng lựa chọn nhưng đang vướng mắc một điều mong các anh chị giúp đỡ:
Giả sử tôi có mãng (Array) là Arr(). Vậy code nào chuyển các phần tử của mãng Arr() thành list của Validation của một cell trên bảng tính
Xin cảm ơn các anh chị

 

[ndu96081631]

Từ bài viết Chương trình chọn thép theo diện tích nhưng chỉ tra được từng diện tích một, thông thường người ta có bảng tính diện tích cốt thép cho nhiều mặt cắt với nhiều cấu kiện khác nhau thì trường hợp này rất mất thời gian. Để khắc phục đều này tôi nghĩ ra phương án là tạo Validation gồm các phương án cho từng diện tích cốt thép để người sử dụng lựa chọn nhưng đang vướng mắc một điều mong các anh chị giúp đỡ:
Giả sử tôi có mãng (Array) là Arr(). Vậy code nào chuyển các phần tử của mãng Arr() thành list của Validation của một cell trên bảng tính
Xin cảm ơn các anh chị

Với Validation thì có 2 cách Add List:
1> Gán Arr xuống 1 cột trên sheet rồi dùng cột này làm list cho Validation ---> Cái này chắc khỏi nói bạn cũng biết
2> Nối chuổi trong Arr theo kiểu Join(Arr, ",") rồi cho vào Validation (kiểu như gõ bằng tay trong validation vậy)... ví dụ:

Sub Test()
  Dim Arr
  Arr = Array("A", "B", "C")
  With Range("A1").Validation
    .Delete
    .Add 3, , , Join(Arr, ",")
  End With
End Sub

 

[viehoai]

Với Validation thì có 2 cách Add List:
1> Gán Arr xuống 1 cột trên sheet rồi dùng cột này làm list cho Validation ---> Cái này chắc khỏi nói bạn cũng biết
2> Nối chuổi trong Arr theo kiểu Join(Arr, ",") rồi cho vào Validation (kiểu như gõ bằng tay trong validation vậy)... ví dụ:

Sub Test()
  Dim Arr
  Arr = Array("A", "B", "C")
  With Range("A1").Validation
    .Delete
    .Add [COLOR=#ff0000]3[/COLOR], , , Join(Arr, ",")
  End With
End Sub

Em xin cảm ơn. Em đã giải quyết được vấn đề

 

[Bi Bo]

Tôi test đoạn này bị lỗi. Các bạn sửa giúp tôi với
Mục đích:
- Các format ngày trong cột B đang ở dạng Text
- Dùng code mảng chuyển nó về formate date

Sub test()
Dim Arr
[B2:B1000].Value = Arr
For i = 1 To UBound(Arr(), 1)
Arr = DateSerial(Year(Arr), Month(Arr), Day(Arr))
Next i
[B2:B1000].Value = Arr

End Sub

Cám ơn