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

[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ị

 

[VetMini]

Đã nói vấn đề này đã được bàn qua rồi mà.
Cách làm căn bản là đổi dòng thành cột, cột thành dòng

1. Nếu mảng nhỏ: dùng hàm transpose và/hoặc index
Vì dùng hàm Worksheet cho nên chỉ dùng được tới vài ngàn dòng.

2. Nếu mảng lớn: tự viết một hàm chuyển.

 

[Hoàng Nhật Phương]

Bỏ dòng đó đi là được.

Hi cảm ơn snow25 đã hỗ trợ.
Mục đích OT chỉ là tìm hiểu thêm về "ReDim Preserve" làm sao để thay đổi kích thước mảng vừa đủ ứng với số phần tử thỏa mãn cần xuất ra ạ.

Đã nói vấn đề này đã được bàn qua rồi mà.
Cách làm căn bản là đổi dòng thành cột, cột thành dòng

1. Nếu mảng nhỏ: dùng hàm transpose và/hoặc index
Vì dùng hàm Worksheet cho nên chỉ dùng được tới vài ngàn dòng.

2. Nếu mảng lớn: tự viết một hàm chuyển.

Dạ, Bác biết link nào bàn chi tiết cho những người "ngu lâu, chậm hiểu" như con có khả năng tiếp thu được chút ít thì Bác chỉ cho con với ạ

 

[snow25]

Hi cảm ơn snow25 đã hỗ trợ.
Mục đích OT chỉ là tìm hiểu thêm về "ReDim Preserve" làm sao để thay đổi kích thước mảng vừa đủ ứng với số phần tử thỏa mãn cần xuất ra ạ.


Dạ, Bác biết link nào bàn chi tiết cho những người "ngu lâu, chậm hiểu" như con có khả năng tiếp thu được chút ít thì Bác chỉ cho con với ạ

Bạn thử cái này.

Sub TongHop2()
    Dim Data(), arr(), i As Long, TenKh As String, j As Long, k As Long
    Sheet2.Range("H2").Resize(1000, 7).ClearContents
    Data = Sheet2.Range("A2:F15").Value
        For i = 1 To UBound(Data)
            If Data(i, 1) = "Tên KH" Then TenKh = Data(i, 2)
            If IsDate(Data(i, 1)) Then
                k = k + 1
                ReDim Preserve arr(1 To 7, 1 To k)
                arr(1, k) = TenKh
                For j = 1 To 6
                    arr(j + 1, k) = Data(i, j)
                Next j
            End If
        Next i
        arr = chuyenmang(arr)
    If k Then
        Sheet2.Range("H2").Resize(k, 7).Value = arr
    End If
End Sub
Function chuyenmang(mang As Variant)
        Dim arr, i As Long, j As Long
        ReDim arr(1 To UBound(mang, 2), 1 To UBound(mang, 1))
             For i = 1 To UBound(mang, 1)
                 For j = 1 To UBound(mang, 2)
                     arr(j, i) = mang(i, j)
                 Next j
             Next i
             chuyenmang = arr
End Function

 

[leonguyenz]

Hi cảm ơn snow25 đã hỗ trợ.
Mục đích OT chỉ là tìm hiểu thêm về "ReDim Preserve" làm sao để thay đổi kích thước mảng vừa đủ ứng với số phần tử thỏa mãn cần xuất ra ạ.


Dạ, Bác biết link nào bàn chi tiết cho những người "ngu lâu, chậm hiểu" như con có khả năng tiếp thu được chút ít thì Bác chỉ cho con với ạ

Mỗi lần Redim mảng sẽ làm chậm tốc độ thực thi, đưa vào vòng lặp để Redim Preserve lại càng thêm chậm.
Như vậy có cần thiết Redim Preserve hay không? Nếu cần thiết thì cứ tính toán hết đi rồi Redim Preserve 1 lần.

 

[Hoàng Nhật Phương]

Bạn thử cái này.

Sub TongHop2()
    Dim Data(), arr(), i As Long, TenKh As String, j As Long, k As Long
    Sheet2.Range("H2").Resize(1000, 7).ClearContents
    Data = Sheet2.Range("A2:F15").Value
        For i = 1 To UBound(Data)
            If Data(i, 1) = "Tên KH" Then TenKh = Data(i, 2)
            If IsDate(Data(i, 1)) Then
                k = k + 1
                ReDim Preserve arr(1 To 7, 1 To k)
                arr(1, k) = TenKh
                For j = 1 To 6
                    arr(j + 1, k) = Data(i, j)
                Next j
            End If
        Next i
        arr = chuyenmang(arr)
    If k Then
        Sheet2.Range("H2").Resize(k, 7).Value = arr
    End If
End Sub
Function chuyenmang(mang As Variant)
        Dim arr, i As Long, j As Long
        ReDim arr(1 To UBound(mang, 2), 1 To UBound(mang, 1))
             For i = 1 To UBound(mang, 1)
                 For j = 1 To UBound(mang, 2)
                     arr(j, i) = mang(i, j)
                 Next j
             Next i
             chuyenmang = arr
End Function

Hihi, cảm ơn snow25 đã cho một cách tham khảo.

Mỗi lần Redim mảng sẽ làm chậm tốc độ thực thi, đưa vào vòng lặp để Redim Preserve lại càng thêm chậm.
Như vậy có cần thiết Redim Preserve hay không? Nếu cần thiết thì cứ tính toán hết đi rồi Redim Preserve 1 lần.

Dạ vâng Anh, OT cũng có nghĩ tốc độ có thể sẽ chậm hơn thật.. chỉ là tham khảo thêm về cách sử dụng Redim Preserve thôi ạ.
Nhưng xem chừng OT vẫn còn ngu ngơ lắm ạ

 

[tueyennhi]

Cho em hỏi về mảng liên quan đến Dic. Em có đọc thấy Item có thể nhận kiểu dữ liệu là mảng. Vậy làm thế nào để add mảng làm item và khi muốn lấy giá trị một phần tử bất kì của mảng (item) đó thì em phải làm thế nào?
Ví dụ đây là đoạn code của em vậy add mảng tại ??? như thế nào mọi người chỉ giúp em được không?

If Ws.Tab.Color = 10498160 Then
     BS = Ws.Range("AJ9", Ws.Range("AJ10000").End(xlUp)).Resize(, 3).Value
     For i = 1 To UBound(BS, 1)
          Tem = BS(i, 1)
          If Not Dic.exists(Tem) And Len(Tem) > 0 Then Dic.Add Tem, ???
     Next i
End If

 

[snow25]

Cho em hỏi về mảng liên quan đến Dic. Em có đọc thấy Item có thể nhận kiểu dữ liệu là mảng. Vậy làm thế nào để add mảng làm item và khi muốn lấy giá trị một phần tử bất kì của mảng (item) đó thì em phải làm thế nào?
Ví dụ đây là đoạn code của em vậy add mảng tại ??? như thế nào mọi người chỉ giúp em được không?

If Ws.Tab.Color = 10498160 Then
     BS = Ws.Range("AJ9", Ws.Range("AJ10000").End(xlUp)).Resize(, 3).Value
     For i = 1 To UBound(BS, 1)
          Tem = BS(i, 1)
          If Not Dic.exists(Tem) And Len(Tem) > 0 Then Dic.Add Tem, ???
     Next i
End If

Bạn gán mảng vào item như bình thường thôi.Còn lấy ra tùy theo bạn muốn lấy cả mảng ra hay từng vị trí của mảng cũng được.

If Ws.Tab.Color = 10498160 Then
     BS = Ws.Range("AJ9", Ws.Range("AJ10000").End(xlUp)).Resize(, 3).Value
     For i = 1 To UBound(BS, 1)
          tem = BS(i, 1)
          If Not dic.exists(tem) And Len(tem) > 0 Then
             dic.Add tem, Array(1, 2, 3)
             MsgBox dic.Item(tem)(0)
             MsgBox dic.Item(tem)(1)
             MsgBox dic.Item(tem)(2)
         end if
     Next i
End If

 

[tueyennhi]

Bạn gán mảng vào item như bình thường thôi.Còn lấy ra tùy theo bạn muốn lấy cả mảng ra hay từng vị trí của mảng cũng được.

If Ws.Tab.Color = 10498160 Then
     BS = Ws.Range("AJ9", Ws.Range("AJ10000").End(xlUp)).Resize(, 3).Value
     For i = 1 To UBound(BS, 1)
          tem = BS(i, 1)
          If Not dic.exists(tem) And Len(tem) > 0 Then
             dic.Add tem, Array(1, 2, 3)
             MsgBox dic.Item(tem)(0)
             MsgBox dic.Item(tem)(1)
             MsgBox dic.Item(tem)(2)
         end if
     Next i
End If

Em muốn gán mảng BS tại vị trí i thì em cần làm như thế nào hả anh? Hay em cần viết thêm là
For j =1 to 3
Arr(i,j)= BS(i,j)
Phải không anh?

 

[CHAOQUAY]

Mỗi lần Redim mảng sẽ làm chậm tốc độ thực thi, đưa vào vòng lặp để Redim Preserve lại càng thêm chậm.
Như vậy có cần thiết Redim Preserve hay không? Nếu cần thiết thì cứ tính toán hết đi rồi Redim Preserve 1 lần.

Việc này có lẽ chưa hoàn toàn đúng. Nếu sau mỗi lần redim preserve mà kích thước mảng giảm, khối lượng tính sẽ giảm, có lẽ code sẽ nhanh hơn ban đầu.
Còn nếu preserve mà kích thước lại tăng thì bó tay.

 

[VetMini]

Việc này có lẽ chưa hoàn toàn đúng. Nếu sau mỗi lần redim preserve mà kích thước mảng giảm, khối lượng tính sẽ giảm, có lẽ code sẽ nhanh hơn ban đầu.
Còn nếu preserve mà kích thước lại tăng thì bó tay.

.
Nói như vậy là rất mơ hồ.

Về Redim Preserve tôi đã từng nói về cách hoạt động của nó rồi. Chịu khó tìm thớt ấy.
Đại khái:
1. Mảng là cấu trúc cổ đại của lập trình. Nó gần như luôn luôn được thể hiện bằng một vùng nhớ liên tục. Mục đích là để giúp tốc độ. Vì vậy tốc độ sẽ liên quan đến chiều hướng truy cập. Và VBA dùng mảng truy theo cột. (Có một bạn đã từng chứng minh duyệt mảng theo cột nhanh hơn theo dòng)
2. Redim Preserve chủ yếu chỉ là tạo một mảng khác rồi copy mảng cũ sang. Khi VBA thực hiện lệnh này thì tôi nghĩ rằng bên trong nó dùng mấy cái macro (macro này viết bằng ASM) để copy toàn cụm vùng nhớ, không ai dại gì copy từng đoạn hay từng phần tử.
3. Mấy cái macro (ASM) dùng để Dim/Redim mảng cũng được viết rất hiệu quả. Cho nên tốc độ tuy có bị ảnh hưởng nhưng không nhiều như ta tưởng tượng.
4. Túm lại thì xào mảng đi lại cũng nên quan tâm ở điểm làm nát (fragment) bộ nhớ. Nhưng với các hệ điều hành mới (Win7 trở đi) thì VBA sử dụng code gom bộ nhớ (dọn rác/garbage collection) rất hiệu quả.

 

[tueyennhi]

Em muốn gán mảng BS tại vị trí i thì em cần làm như thế nào hả anh? Hay em cần viết thêm là
For j =1 to 3
Arr(i,j)= BS(i,j)
Phải không anh?

Bạn gán mảng vào item như bình thường thôi.Còn lấy ra tùy theo bạn muốn lấy cả mảng ra hay từng vị trí của mảng cũng được.

If Ws.Tab.Color = 10498160 Then
     BS = Ws.Range("AJ9", Ws.Range("AJ10000").End(xlUp)).Resize(, 3).Value
     For i = 1 To UBound(BS, 1)
          tem = BS(i, 1)
          If Not dic.exists(tem) And Len(tem) > 0 Then
             dic.Add tem, Array(1, 2, 3)
             MsgBox dic.Item(tem)(0)
             MsgBox dic.Item(tem)(1)
             MsgBox dic.Item(tem)(2)
         end if
     Next i
End If

Em làm được rồi nhé. Cảm ơn anh!

Private Sub BoSungCong()
Dim BS(), i As Long, Dic As Object, Tem As String
Dim Ws As Worksheet
Set Dic = CreateObject("Scripting.Dictionary")
    For Each Ws In Worksheets
        If Ws.Tab.Color = 10498160 Then
            BS = Ws.Range("AJ9", Ws.Range("AJ10000").End(xlUp)).Resize(, 3).Value
            For i = 1 To UBound(BS, 1)
                Tem = Cells(i + 8, 3)
                If Not IsEmpty(Tem) And Not Dic.exists(Tem) Then Dic.Add Tem, Array(BS(i, 1), BS(i, 2), BS(i, 3))
            Next i
        End If
    Next Ws
End Sub

 

[CHAOQUAY]

Nói như vậy là rất mơ hồ.
...

Có lẽ nếu khối lượng tính toán giảm đáng kể tài nguyên máy so với redim preserve thì việc này cũng nên thử.
Thực tế sử dụng, nếu redim preserve cho mảng 1 chiều trong vòng lặp thấy có vẻ tốt bác ạ. Cái này thấy giống như lệnh Remove trong dictionary khi dùng trong vòng lặp.
Em chỉ thực tế thôi bác ạ.

 

[VetMini]

Tôi thường dùng từ rất đúng ngữ cảnh và ngữ pháp. Nếu tôi cho rằng "sai" thì tôi đã dùng từ "sai".
Tôi dùng từ "rất mơ hồ" bởi vì tôi cho rằng nói như vậy là "mơ hồ":
Chỉ nói suông kích thước tăng/giảm như vậy chưa đủ. Ít nhất phải cho biết tại sao thêm 1 dòng/cột lại tốn tài nguyên hơn bớt 1 dòng/cột.
Ví dụ: (giải thích rằng) thêm cột thì VBA phải tạo vùng nhớ mới; bớt cột thì vẫn giữ vùng nhớ ấy, chỉ thu ngắn lại thôi.
Lưu ý: ví dụ cụ thể thôi, thực tế tôi không tin VBA làm vậy. Tôi biết các macro tạo vùng nhớ và copy vùng nhớ của hệ thống làm việc hiệu quả lắm. Điển hình là mỗi lần bạn dùng toán tử & để gộp chuỗi là VBA phải tạo vùng nhớ mới và copy qua. (*)

(*) Đối với chuỗi, tôi vẫn khuyên là nếu tránh dùng & thì lại hiệu quả hơn. Nhưng nếu không tránh được thì cũng không đến nổi tốn kém quá.

 

[CHAOQUAY]

Tôi thường dùng từ rất đúng ngữ cảnh và ngữ pháp. Nếu tôi cho rằng "sai" thì tôi đã dùng từ "sai".
Tôi dùng từ "rất mơ hồ" bởi vì tôi cho rằng nói như vậy là "mơ hồ":
Chỉ nói suông kích thước tăng/giảm như vậy chưa đủ. Ít nhất phải cho biết tại sao thêm 1 dòng/cột lại tốn tài nguyên hơn bớt 1 dòng/cột.
Ví dụ: (giải thích rằng) thêm cột thì VBA phải tạo vùng nhớ mới; bớt cột thì vẫn giữ vùng nhớ ấy, chỉ thu ngắn lại thôi.
Lưu ý: ví dụ cụ thể thôi, thực tế tôi không tin VBA làm vậy. Tôi biết các macro tạo vùng nhớ và copy vùng nhớ của hệ thống làm việc hiệu quả lắm. Điển hình là mỗi lần bạn dùng toán tử & để gộp chuỗi là VBA phải tạo vùng nhớ mới và copy qua. (*)

(*) Đối với chuỗi, tôi vẫn khuyên là nếu tránh dùng & thì lại hiệu quả hơn. Nhưng nếu không tránh được thì cũng không đến nổi tốn kém quá.

Nếu chỉ xét riêng việc redim preserve trong vòng lặp thì chắc là code sẽ chậm hơn khi không redim, nhưng thực tế, viêc quét qua mảng thường kèm theo các phép tính liên quan nên việc redim mảng trong một số trường hợp có thể làm giảm khối lượng tính đi kèm. Trong trường hợp này, nếu khối lượng công việc đi kèm là đáng kể thì có thể code sẽ nhanh hơn nếu không redim & ngược lại, tính toán kèm theo là không lớn thì code cũng sẽ vẫn chậm hơn khi không redim.
Việc đánh giá là mơ hồ chỗ này thì cũng hoàn toàn đồng ý với bác .

 

[Nguyễn Hồng Quang]

bài đã xóa

 

[befaint]

Em có 2 mảng dữ liệu gồm mảng 1 và mảng 2 như trong File và kết quả mong muốn so sánh giữa 2 mảng này. Em mong anh (chị) trong diễn đàn giúp đỡ em bằng vba với. Em xin cảm ơn

Những bài to to thì lập chủ đề ấy. Câu hỏi nho nhỏ thì đăng vào đây.

 

[Nguyễn Hồng Quang]

Những bài to to thì lập chủ đề ấy. Câu hỏi nho nhỏ thì đăng vào đây.

Cảm ơn anh đã nhắc nhở , em sẽ xoá bài này và Lập chủ đề riêng

 

[HuyDương07]

Chào mọi người trong group

hiện tại mình mới bắt đầu học VBA excel (mình bên logictics) muốn có vấn đề muốn hỏi mong các pro chỉ giúp :
1. autofillter : mình có 1 bang data , mình muốn tự lọc theo dự liệu paste 1 cột
+> phần điều kiện Criteria : cột dữ lieu muốn filter thành 1 chuỗi arr(....) =Criteria?
+> có cần xác định dòng cuối dự lieu cần lọc không? có thì xin chỉ giáo giúp
2> khi lọc được những dữ lieu mình muốn lọc :
+> Tìm được date >2/3 ( date = ((HSD -now())/HSD - NXS) và số lượng của những dữ lieu (mã hang) mà mình muốn lọc

 

[VetMini]

Chào mọi người trong group

hiện tại mình mới bắt đầu học VBA excel (mình bên logictics) muốn có vấn đề muốn hỏi mong các pro chỉ giúp :
...

bên "logictics" là bên đâu vậy? Tây hay Mẽo?

 

[Minh Tùng]

Vấn đề của em khá nhỏ nên em không lập topic mới ạ (nếu em đăng sai, nhờ BQT nhắc nhở để em đăng bài mới)

Em có biến LastRow để xác định dòng cuối
Em cần chọn nhiều vùng không liền nhau kết hợp LastRow để xác định dữ liệu mảng động để format trước khi thêm dữ liệu vào sheetform nhưng em chưa viết được code (như hình em cần chọn ô bắt đầu là B2:C & LastRow, E2 & LastRow, G2 & LastRow, I2:K & LastRow,....)

Mong anh/chị GPE giúp em ạ.
Em cám ơn nhiều!

 

[snow25]

Vấn đề của em khá nhỏ nên em không lập topic mới ạ (nếu em đăng sai, nhờ BQT nhắc nhở để em đăng bài mới)

Em có biến LastRow để xác định dòng cuối
Em cần chọn nhiều vùng không liền nhau kết hợp LastRow để xác định dữ liệu mảng động để format trước khi thêm dữ liệu vào sheetform nhưng em chưa viết được code (như hình em cần chọn ô bắt đầu là B2:C & LastRow, E2 & LastRow, G2 & LastRow, I2:K & LastRow,....)

Mong anh/chị GPE giúp em ạ.
Em cám ơn nhiều!

Bạn viết vậy là bị lỗi.Bạn nên tách cái nào là biến cái nào là ký tự ra chứ.Bạn viết thế kia nó không hiểu cái Lastrow là gì cả.

 

[Minh Tùng]

Bạn viết vậy là bị lỗi.Bạn nên tách cái nào là biến cái nào là ký tự ra chứ.Bạn viết thế kia nó không hiểu cái Lastrow là gì cả.

Tại vì em viết để dể hình dung đó anh
Bình thường nếu 1 vùng thì em sẽ viết là:

With Sheet1.Range("B2:B" & LastRow)
Code trong đây....
End With

Nhưng em chọn nhiều vùng không liên tục kèm theo biến LastRow thì em chưa làm được ạ.
Anh giúp em thêm được không?

 

[Ba Tê]

Tại vì em viết để dể hình dung đó anh
Bình thường nếu 1 vùng thì em sẽ viết là:

With Sheet1.Range("B2:B" & LastRow)
Code trong đây....
End With

Nhưng em chọn nhiều vùng không liên tục kèm theo biến LastRow thì em chưa làm được ạ.
Anh giúp em thêm được không?

Xem thử Sub này coi nó hoạt động được không nhé.

Public Sub Gpe()
Dim LastRws As Long
LastRws = 10
Range("A1:A" & LastRws & ",C1:C" & LastRws & ",E1:E" & LastRws) = "GPE"
End Sub

 

[befaint]

chọn nhiều vùng không liên tục kèm theo biến LastRow

Sub vidu()
    Const last_Row As Long = 9
    array_range = Array("B2:C" & last_Row, "E2:E" & last_Row, "G2:G" & last_Row, "I2:K" & last_Row)
    string_range = Join(array_range, ",")
    Sheet1.Range(string_range).Select
End Sub

 

[snow25]

Tại vì em viết để dể hình dung đó anh
Bình thường nếu 1 vùng thì em sẽ viết là:

With Sheet1.Range("B2:B" & LastRow)
Code trong đây....
End With

Nhưng em chọn nhiều vùng không liên tục kèm theo biến LastRow thì em chưa làm được ạ.
Anh giúp em thêm được không?

Vậy bạn viết như thế này.
With Sheet1.Range("B2:B" & LastRow & ",D2" & lastrow)
Code trong đây....
End With

 

[Minh Tùng]

Xem thử Sub này coi nó hoạt động được không nhé.

Public Sub Gpe()
Dim LastRws As Long
LastRws = 10
Range("A1:A" & LastRws & ",C1:C" & LastRws & ",E1:E" & LastRws) = "GPE"
End Sub

Vậy bạn viết như thế này.
With Sheet1.Range("B2:B" & LastRow & ",D2" & lastrow)
Code trong đây....
End With

Sub vidu()
    Const last_Row As Long = 9
    array_range = Array("B2:C" & last_Row, "E2:E" & last_Row, "G2:G" & last_Row, "I2:K" & last_Row)
    string_range = Join(array_range, ",")
    Sheet1.Range(string_range).Select
End Sub

Em cám ơn anh @Ba Tê , anh @snow25 , anh @befaint
3 cách của 3 anh đều sử dụng được hết ạ.

 

[Ngô Vương Thông]

Anh chị cho em hỏi , e muốn đưa Worksheets("PHMail").Range("A1:A12") vào 1 mảng
sau đó sẽ cho mỗi dòng tương ứng trong mảng() =.... [VD: mảng() = UniConvert(" Yeeu caafu hoox trowj : ", "Telex") & arr(i, 12) ]
=> Cuối cùng e gán mảng() lên Listview
Note : ở userform e có để một textbox stt => khi nhập stt vào sẽ nhảy đúng nội dung theo dòng của mảng()
Hiện tại khi e thay đổi STT thì nội dung vẫn sẽ được thay đổi nhưng tốc độ rất chậm, quay khoảng 3s mới có kết quả
Mong các anh chị chỉ giáo tối ưu giúp em


Dim arr(), i As Long
If Worksheets("Record_Ticket").Range("A2000").End(xlUp).Row < 2 Then Exit Sub
arr = Worksheets("Record_Ticket").Range("A2", Worksheets("Record_Ticket").Range("A2000").End(xlUp)).Resize(, 27).Value
'Worksheets("PHMail").Range("A1,A3,A4,A5,A6,A9").ClearContents
i = Worksheets("PHMail").Range("C2").Value
If i <> Empty Then
If i <= UBound(arr) Then
If arr(i, 20) = "" Then
Worksheets("PHMail").Range("A1") = ConvertToUnSign("Tiep Nhan" & "-" & arr(i, 7) & "-")
Worksheets("PHMail").Range("A3") = UniConvert(" Yeeu caafu hoox trowj : ", "Telex") & arr(i, 12)
Worksheets("PHMail").Range("A4") = UniConvert(" Thowfi gian nhaajn yeeu caafu hoox trowj : " & arr(i, 3) & " - " & arr(i, 4), "Telex")
Worksheets("PHMail").Range("A5") = UniConvert(" Thowfi gian tieesn hafnh hoox trowj : " & arr(i, 3) & " - " & arr(i, 19), "Telex")
Worksheets("PHMail").Range("A6") = UniConvert(" Thowfi gian xuwr lys hoafn taast : " & arr(i, 22) & " - " & arr(i, 20), "Telex")
Worksheets("PHMail").Range("A9") = "-" & arr(i, 15)
Else
Worksheets("PHMail").Range("A1") = ConvertToUnSign("Hoan tat" & "-" & arr(i, 7) & "-" & arr(i, 8) & "-" & arr(i, 12))
Worksheets("PHMail").Range("A3") = UniConvert(" Yeeu caafu hoox trowj : ", "Telex") & arr(i, 12)
Worksheets("PHMail").Range("A4") = UniConvert(" Thowfi gian nhaajn yeeu caafu hoox trowj : " & arr(i, 3) & " - " & arr(i, 4), "Telex")
Worksheets("PHMail").Range("A5") = UniConvert(" Thowfi gian tieesn hafnh hoox trowj : " & arr(i, 3) & " - " & arr(i, 19), "Telex")
Worksheets("PHMail").Range("A6") = UniConvert(" Thowfi gian xuwr lys hoafn taast : " & arr(i, 22) & " - " & arr(i, 20), "Telex")
Worksheets("PHMail").Range("A9") = "-" & arr(i, 15)
End If
End If
End If

 

[phuoclocvl]

Các Anh cho em hỏi.
Thí dụ trong 1 cột em muốn nối các cell lại với nhau, nhưng không phải nối lại hết mà nối 5 cell chẳn hạn, rồi thực thi những tác vụ khác, rồi nối tiếp từ cell 6 tới cell 10 và tiếp tục thực thi tiếp cho đến khi hết dữ liệu. Em chỉ biết nối hết 1 lần à. Ko biết tách ra.
Code em nè
Sub Test()
Dim eR As Long
Dim i As Long
Dim temp As String
With Sheet1
eR = .Range("A10000").End(xlUp).Row
For i = 2 To eR
If .Cells(i, 1) <> "" Then
temp = temp & .Cells(i, 1) & "','"
End If
Next i
.Range("B1") = "('" & Left(temp, Len(temp) - 2) & ")"
End With
End Sub

 

[SA_DQ]

Các Anh cho em hỏi. . . . .

Sub gpeNoi5()
With Sheet1
    eR = [A65500].End(xlUp).Row
    For I = 2 To eR Step 5
        If .Cells(I, 1) <> "" Then
            For W = 0 To 4
                Temp = Temp & .Cells(I + W, 1) & "','"
            Next W
            .Cells(I, 2).Value = Temp:                  Temp = ""
        End If
        GPELamGiTiepThiLam
    Next I
End With
End Sub

? Chưa chắc đã đúng ý của bạn.

 

[phuoclocvl]

Sub gpeNoi5()
With Sheet1
    eR = [A65500].End(xlUp).Row
    For I = 2 To eR Step 5
        If .Cells(I, 1) <> "" Then
            For W = 0 To 4
                Temp = Temp & .Cells(I + W, 1) & "','"
            Next W
            .Cells(I, 2).Value = Temp:                  Temp = ""
        End If
        GPELamGiTiepThiLam
    Next I
End With
End Sub

? Chưa chắc đã đúng ý của bạn.

Dạ chào Anh,
kết quả có vẻ ngon rồi đấy, nhưng sao bỏ được mấy cái nối trống phía sau anh. dòng 16 á có nhiều cái dưa quá à

A
1	1','2','3','4','5','
2
3
4
5
6	6','7','8','9','10','
7
8
9
10
11	11','12','13','14','15','
12
13
14
15
16	16','','','','','

 

[Ba Tê]

...................
kết quả có vẻ ngon rồi đấy, nhưng sao bỏ được mấy cái nối trống phía sau anh. dòng 16 á có nhiều cái dưa quá à

Bạn thử với cái này xem sao:

Option Explicit

Public Sub sGpe()
Dim sArr(), dArr(), I As Long, N As Long, R As Long, Tmp As String
    sArr = Range("A1", Range("A50000").End(xlUp)).Value     'Cot A, bat dau tu A1'
    R = UBound(sArr)
    ReDim dArr(1 To R, 1 To 1)
For I = 1 To R Step 5       'Buoc nhay 5'
    Tmp = ""
    For N = I To I + 4
        If N <= R Then Tmp = Tmp & IIf(Len(Tmp), "; ", "") & sArr(N, 1)
    Next N
    dArr(I, 1) = Tmp
Next I
    '------------------------------ Format Cot B Kieu Text'
    Range("B1").Resize(R) = dArr    'Ket Qua bat dau tu B1'
End Sub

 

[SA_DQ]

Câu lệnh
Temp = Temp & .Cells(I + W, 1) & "','"
biến hóa từ nguồn của bạn mà: temp = temp & .Cells(i, 1) & "','"
Mình nghỉ bạn sẽ phải tự xử lý chuyện này & mình tin chắc là được

(Gợi ý: Ra điều kiện trước khi nối chuỗi; Đó là cách tuy dài dòng trong câu lệnh nhưng thông dụng & dễ xử!)

 

[phuoclocvl]

Câu lệnh
Temp = Temp & .Cells(I + W, 1) & "','"
biến hóa từ nguồn của bạn mà: temp = temp & .Cells(i, 1) & "','"
Mình nghỉ bạn sẽ phải tự xử lý chuyện này & mình tin chắc là được

(Gợi ý: Ra điều kiện trước khi nối chuỗi; Đó là cách tuy dài dòng trong câu lệnh nhưng thông dụng & dễ xử!)

Dạ,

Đã xử xong rồi hì . cảm ơn các anh nhiều nhiều nha

Sub gpeNoi5()
With Sheet1
eR = [A65500].End(xlUp).Row
For I = 2 To eR Step 5
If .Cells(I, 1) <> "" Then
For W = 0 To 4
If .Cells(I + W, 1) <> "" Then
Temp = Temp & .Cells(I + W, 1) & "','"
End if
Next W
.Cells(I, 2).Value = Temp: Temp = ""
End If
GPELamGiTiepThiLam
Next I
End With
End Sub

 

[phuoclocvl]

Câu lệnh
Temp = Temp & .Cells(I + W, 1) & "','"
biến hóa từ nguồn của bạn mà: temp = temp & .Cells(i, 1) & "','"
Mình nghỉ bạn sẽ phải tự xử lý chuyện này & mình tin chắc là được

(Gợi ý: Ra điều kiện trước khi nối chuỗi; Đó là cách tuy dài dòng trong câu lệnh nhưng thông dụng & dễ xử!)

Mục đích em là vầy nè các anh, em đã chạy OK rồi. xin đa tạ ạ

Dim Temp As String, iLock As String, eDr As Integer
Dim sD As Worksheet, rD As Worksheet
Dim adors As New Recordset
Set sD = Worksheets("Final")
Set rD = Worksheets("BOM_MAT")
rD.Range("A3:K").End(xlUp).ClearContents
rD.Range("A2").Resize(, 11) = Array("IT_FG", "SUB_IT", "BOM_REQ", "IT_CLASS", "BOM_DESC", "IT_TYPE", "SUB_TYPE", "UNIT", "SITE", "TYPE_R", "SECTION")
eR = sD.Range("A100000").End(xlUp).Row
For I = 2 To eR Step 250
If sD.Cells(I, 1) <> "" Then
For W = 0 To 249
If sD.Cells(I + W, 1) <> "" Then
Temp = Temp & sD.Cells(I + W, 1) & "','"
End If
Next W
iLock = "('" & Left(Temp, Len(Temp) - 2) & ")": Temp = ""
End If
'--- Bat dau load du lieu he thong -----
Set Db = New Connection
Db.CursorLocation = adUseClient

If Db.State = 1 Then Db.Close
Db.Open "PROVIDER=MSDASQL;DRIVER={Client Access ODBC Driver (32-bit)}" & _
";SYSTEM=10.9.3.106;DBQ=QGPL " & _
"AMFLIBW;DFTPKGLIB=QGPL;XLATEDLL=;" & _
"LANGUAGEID=ENU;SORTTABLE=;PKG=QGPL/DEFAULT(IBM),2,0,1,0,512;QAQQINILIB=;" & _
"DESC=;XDYNAMIC=0;TRANSLATE=1;" & _
";UID=WANEKPIC" & _
";PWD=WANEKPIC"

Set adors = New Recordset
If adors.State = 1 Then adors.Close

cmdtxt = "SELECT DISTINCT TRIM(PSTBOMD.BOMPIT),TRIM(PSTBOMD.BOMCIT),PSTBOMD.BOMGQT,TRIM(PSTBOMD.BOMCCL),PSTBOMD.BOMCDS,PSTBOMD.PITTYP,PSTBOMD.ITTYP,PSTBOMD.UNMSR,RTGOPR.STID " & _
"FROM RGNFILW.PSTBOMD PSTBOMD, AMFLIBW.RTGOPR RTGOPR " & _
"WHERE RTGOPR.RTID=PSTBOMD.BXDCOMPONENTITEMNUMBER AND PSTBOMD.BOMPIT in " & iLock & " AND BOMPIT NOT LIKE '%TEMP%' " & _
"AND BOMPCL IN ('UESW','WPLS','ZDYB','PLST','HDBD','WVCS','FPUW','UESC','UEPM','WNPU','WNPS','WNCS','RLRK','WNPU','UEUS','WNAD','ZSOA','TA') AND BOMGQT>0 AND BOMCIT NOT LIKE '%MOD%' AND BOMPIT NOT LIKE '%FNSH%'"
Debug.Print cmdtxt
adors.Open cmdtxt, Db, 3, 3
eDr = rD.Range("A100000").End(xlUp).Row + 1
For I1 = 0 To adors.Fields.Count - 1
rD.Cells(eDr, I1 + 1) = adors.Fields(I1).Name
Next I1
rD.Range("A" & eDr).CopyFromRecordset adors
adors.Close
Set adors = Nothing
Next I
' Chep cong thuc
eDr = rD.Range("A100000").End(xlUp).Row
rD.Range("J1:K1").Copy
rD.Range("J3:K" & dc).PasteSpecial xlPasteFormulas
Application.Calculation = xlAutomatic
rD.Range("J3:K" & dc).Copy
rD.Range("J3:K" & dc).PasteSpecial xlPasteValues
Application.Calculation = xlManual
Call get_bomrq

 

[ThangCuAnh]

Good, tự mày mò, tự làm được thì rất tốt. Không ai có thể làm giúp bạn 100% cả.

 

[VetMini]

Một vấn đề hỏi 2 ngày, úp úp mở mở 2 nơi. Rốt cuộc chỉ là 1 vấn đề cần nối chuỗi làm reference cho câu lệnh SQL.

(*) làm việc với database thì kết nối 1 lần, truy vấn nhiều lần chứ đâu lại mỗi lần truy vấn lại một lần kết nối.

 

[phuoclocvl]

Một vấn đề hỏi 2 ngày, úp úp mở mở 2 nơi. Rốt cuộc chỉ là 1 vấn đề cần nối chuỗi làm reference cho câu lệnh SQL.

(*) làm việc với database thì kết nối 1 lần, truy vấn nhiều lần chứ đâu lại mỗi lần truy vấn lại một lần kết nối.

Dạ là, do em có nhiều item lắm , mà mỗi lần load dữ liệu nó chỉ cho chạy 250 items thôi anh. Nên phải ngắt ra ạ

 

[VetMini]

Dạ là, do em có nhiều item lắm , mà mỗi lần load dữ liệu nó chỉ cho chạy 250 items thôi anh. Nên phải ngắt ra ạ

Có lẽ bạn không hiểu tôi nói gì về "kết nối"

Vả lại, làm kiểu "ngắt ra" như thế này nguy hiểm bỏ xừ. Nó không bảo đảm được khi dữ liệu bị lặp lại.

 

[phuoclocvl]

Có lẽ bạn không hiểu tôi nói gì về "kết nối"

Vả lại, làm kiểu "ngắt ra" như thế này nguy hiểm bỏ xừ. Nó không bảo đảm được khi dữ liệu bị lặp lại.

Có lẽ bạn không hiểu tôi nói gì về "kết nối"

Vả lại, làm kiểu "ngắt ra" như thế này nguy hiểm bỏ xừ. Nó không bảo đảm được khi dữ liệu bị lặp lại.

anh có cách nào hay giúp em với, em chỉ nghĩ được vậy thôi à, do em cũng không rành vụ này

 

[VetMini]

anh có cách nào hay giúp em với, em chỉ nghĩ được vậy thôi à, do em cũng không rành vụ này

Cách bạn diễn tả rất khó hiểu, rất khó viết code cho chính xác. Vì vậy nếu bạn thấy code của mình được rồi thì cứ việc xài.
Tôi chỉ nói về cái vụ "kết nối" và "dữ liệu lặp lại" cho các bạn khác để ý nếu muốn copy code về thử.

 

[phuoclocvl]

Cách bạn diễn tả rất khó hiểu, rất khó viết code cho chính xác. Vì vậy nếu bạn thấy code của mình được rồi thì cứ việc xài.
Tôi chỉ nói về cái vụ "kết nối" và "dữ liệu lặp lại" cho các bạn khác để ý nếu muốn copy code về thử.

Dạ, Thật ra em nói nhiều lúc em còn không hiểu nữa á.

Mục đích của là như vầy:

1. Em có 1 list những item. Do số lượng có thể lên đến 500 items, nhưng hệ thống chỉ cho load mỗi lần khoảng 250 items thôi.
2. Nhưng em muốn cho nó load một lần, không phải thoát ra rồi load lại.

Vì vậy nên em mới cho nó ngắt ra để load.

Là như vậy anh.

Cảm ơn anh đã hỗ trợ,

 

[phuoclocvl]

Dạ chào Anh Em,

cái này chuyển thành mãng như thế nào ạ. Xin cảm ơn,

Public Sub MU()
Dim i, j, k As Long
Dim fn As Worksheet
Set fn = Worksheets("FINAL")
k = 2
fn.Range("Q:V").ClearContents
fn.Range("Q2").Resize(, 8) = Array("ITEM", "DATE_DUE", "QTY", "D/N/H", "RUN#", "IN-CHARGE", "LINE", "DATE")
For i = 3 To fn.Range("A" & Rows.Count).End(xlUp).Row
For j = 5 To 13
If fn.Cells(i, j).Value > 0 Then
k = k + 1
fn.Cells(k, 17) = fn.Cells(i, 2) 'ITEM
fn.Cells(k, 18) = Format(fn.Cells(2, j), "mmddyyyy") & fn.Cells(i, 1) 'DATE_DUE
fn.Cells(k, 19) = fn.Cells(i, j) 'QTY
fn.Cells(k, 20) = fn.Cells(i, 14) 'DO NOT
fn.Cells(k, 21) = fn.Cells(i, 3)
fn.Cells(k, 22) = fn.Cells(i, 15)
fn.Cells(k, 23) = fn.Cells(i, 1)
fn.Cells(k, 24) = "1" & Format(fn.Cells(2, j), "YYMMDD") 'DATE
End If
Next j
Next i
MsgBox "Get data finished!!"
End Sub

 

[leonguyenz]

Dạ chào Anh Em,

cái này chuyển thành mãng như thế nào ạ. Xin cảm ơn,

Public Sub MU()
Dim i, j, k As Long
Dim fn As Worksheet
Set fn = Worksheets("FINAL")
k = 2
fn.Range("Q:V").ClearContents
fn.Range("Q2").Resize(, 8) = Array("ITEM", "DATE_DUE", "QTY", "D/N/H", "RUN#", "IN-CHARGE", "LINE", "DATE")
For i = 3 To fn.Range("A" & Rows.Count).End(xlUp).Row
For j = 5 To 13
If fn.Cells(i, j).Value > 0 Then
k = k + 1
fn.Cells(k, 17) = fn.Cells(i, 2) 'ITEM
fn.Cells(k, 18) = Format(fn.Cells(2, j), "mmddyyyy") & fn.Cells(i, 1) 'DATE_DUE
fn.Cells(k, 19) = fn.Cells(i, j) 'QTY
fn.Cells(k, 20) = fn.Cells(i, 14) 'DO NOT
fn.Cells(k, 21) = fn.Cells(i, 3)
fn.Cells(k, 22) = fn.Cells(i, 15)
fn.Cells(k, 23) = fn.Cells(i, 1)
fn.Cells(k, 24) = "1" & Format(fn.Cells(2, j), "YYMMDD") 'DATE
End If
Next j
Next i
MsgBox "Get data finished!!"
End Sub

Tham khảo code chuyển qua mảng:

Public Sub MU_Array()
Dim i As Long, j As Long, k As Long, sArr(), reArr()
With Worksheets("FINAL")
    .Range("Q:X").ClearContents
    .Range("Q2").Resize(, 8) = Array("ITEM", "DATE_DUE", "QTY", "D/N/H", "RUN#", "IN-CHARGE", "LINE", "DATE")
    sArr = .Range("A3:O" & .Range("A65535").End(xlUp).Row).Value
    ReDim reArr(1 To 9 * UBound(sArr, 1), 1 To 8)
    For i = 1 To UBound(sArr, 1)
        For j = 5 To 13
            If sArr(i, j) > 0 Then
                k = k + 1
                reArr(k, 1) = sArr(i, 2) 'ITEM
                reArr(k, 2) = Format(sArr(2, j), "mmddyyyy") & sArr(i, 1) 'DATE_DUE
                reArr(k, 3) = sArr(i, j) 'QTY
                reArr(k, 4) = sArr(i, 14) 'DO NOT
                reArr(k, 5) = sArr(i, 3)
                reArr(k, 6) = sArr(i, 15)
                reArr(k, 7) = sArr(i, 1)
                reArr(k, 8) = "1" & Format(sArr(2, j), "YYMMDD") 'DATE
            End If
        Next j
    Next i
    If k Then .Range("Q3").Resize(k, 8) = reArr
    MsgBox "Get data finished!!"
End With
End Sub

 

[phuoclocvl]

Tham khảo code chuyển qua mảng:

Public Sub MU_Array()
Dim i As Long, j As Long, k As Long, sArr(), reArr()
With Worksheets("FINAL")
    .Range("Q:X").ClearContents
    .Range("Q2").Resize(, 8) = Array("ITEM", "DATE_DUE", "QTY", "D/N/H", "RUN#", "IN-CHARGE", "LINE", "DATE")
    sArr = .Range("A3:O" & .Range("A65535").End(xlUp).Row).Value
    ReDim reArr(1 To 9 * UBound(sArr, 1), 1 To 8)
    For i = 1 To UBound(sArr, 1)
        For j = 5 To 13
            If sArr(i, j) > 0 Then
                k = k + 1
                reArr(k, 1) = sArr(i, 2) 'ITEM
                reArr(k, 2) = Format(sArr(2, j), "mmddyyyy") & sArr(i, 1) 'DATE_DUE
                reArr(k, 3) = sArr(i, j) 'QTY
                reArr(k, 4) = sArr(i, 14) 'DO NOT
                reArr(k, 5) = sArr(i, 3)
                reArr(k, 6) = sArr(i, 15)
                reArr(k, 7) = sArr(i, 1)
                reArr(k, 8) = "1" & Format(sArr(2, j), "YYMMDD") 'DATE
            End If
        Next j
    Next i
    If k Then .Range("Q3").Resize(k, 8) = reArr
    MsgBox "Get data finished!!"
End With
End Sub

Dạ, cho em hỏi thêm, sao phải nhân 9 chổ này ạ
ReDim reArr(1 To 9 * UBound(sArr, 1), 1 To 8)

 

[leonguyenz]

Dạ, cho em hỏi thêm, sao phải nhân 9 chổ này ạ
ReDim reArr(1 To 9 * UBound(sArr, 1), 1 To 8)

Bạn cho J chạy từ 5 đến 13, có 9 cột.
Nếu dữ liệu sArr(i,j) > 0 đều thỏa mãn thì bạn phải cần 9* Ubound(sArr,1) dòng để ghi vào mảng kết quả reArr

 

[phuoclocvl]

Bạn cho J chạy từ 5 đến 13, có 9 cột.
Nếu dữ liệu sArr(i,j) > 0 đều thỏa mãn thì bạn phải cần 9* Ubound(sArr,1) dòng.

À, giờ mới hiểu hèn chi mình làm mà nó cứ thiếu hahaa.
Cảm ơn rất nhiều,

 

[lycanthrope12]

Option Explicit

Public Sub sGpe()
Dim sArr(), dArr(), I As Long, N As Long, R As Long, Tmp As String
sArr = Range("A1", Range("A50000").End(xlUp)).Value 'Cot A, bat dau tu A1'
R = UBound(sArr)
ReDim dArr(1 To R, 1 To 1)
For I = 1 To R Step 5 'Buoc nhay 5'
Tmp = ""
For N = I To I + 4
If N <= R Then Tmp = Tmp & IIf(Len(Tmp), "; ", "") & sArr(N, 1)
Next N
dArr(I, 1) = Tmp
Next I
'------------------------------ Format Cot B Kieu Text'
Range("B1").Resize(R) = dArr 'Ket Qua bat dau tu B1'
End Sub

Có ai giải thích cho em tại sao mảng dArr(R, 1) có giá trị theo chiều ngang mà gán được giá trị theo chiều dọc được ko. Em ngỡ phải dùng hàm Tranpose nữa nhỉ???

 

[VetMini]

Có ai giải thích cho em tại sao mảng dArr(R, 1) có giá trị theo chiều ngang mà gán được giá trị theo chiều dọc được ko. Em ngỡ phải dùng hàm Tranpose nữa nhỉ???

Ở đâu nói dArr(R, 1) là "mảng" và "có giá trị theo chiều ngang" vậy?

 

[phuoclocvl]

Có ai giải thích cho em tại sao mảng dArr(R, 1) có giá trị theo chiều ngang mà gán được giá trị theo chiều dọc được ko. Em ngỡ phải dùng hàm Tranpose nữa nhỉ???

Theo mình biết thì (dArr(R,1)) giống như cell .

 

[snow25]

Theo mình biết thì (dArr(R,1)) giống như cell .

Cái này nó là 1 phần tử trong mảng 2 chiều nhé bạn.

 

[VetMini]

Theo mình biết thì (dArr(R,1)) giống như cell .

Theo toán học, toán tử "giống như" có tính truyền. Nếu A giống như B và B giống như C thì suy ra A giống như C.
Nếu bạn biết dArr(R,1) giống như cell, và từ đó bạn suy ra dArr(R,1) giống như mảng thì bắt buộc phải có một chỗ nào đó bạn "biết" là cell giống như mảng? Rất tiếc, cell không hề giống như mảng.
Kết lại, giả thuyết của bạn, dArr(R,1) là mảng đã sai từ đầu. Chưa kể đến giả thuyết "có giá trị theo chiều ngang".

 

[ptm0412]

Theo toán học, toán tử "giống như" có tính truyền. Nếu A giống như B và B giống như C thì suy ra A giống như C.
Nếu bạn biết dArr(R,1) giống như cell, và từ đó bạn suy ra dArr(R,1) giống như mảng thì bắt buộc phải có một chỗ nào đó bạn "biết" là cell giống như mảng? Rất tiếc, cell không hề giống như mảng.
Kết lại, giả thuyết của bạn, dArr(R,1) là mảng đã sai từ đầu. Chưa kể đến giả thuyết "có giá trị theo chiều ngang".

Anh VetMini nói đúng: mảng không giống cell.
Nếu nói giống thì chỉ giống cách tra cứu dòng, cột: Range.Cells(r, c) là cách tra cứu giá trị 1 cell trong range, Arr(r, c) là tra cứu giá trị 1 phần tử của mảng

 

[Khanh199x]

Em mới tập tành viết code VBA và có viết thử hàm nội suy 1 chiều dùng mảng ạ nhưng mà không hiểu sao khi nội suy xong giá trị của nó tính ra lại bằng 1 hoặc bằng 0, trong khi em dùng công thức đó tính tay thử kết quả lại ra đúng với lại em xem các giá trị của biến trên cửa sổ Local thì gán đều đúng mà không hiểu sao lại lại không nội suy được mong được các anh chị trên diễn đàn giúp đỡ tìm lỗi em cảm ơn ạ.
Function noisuykz(diahinh As String, caodo As Double) As Double
Dim arr1()
arr1 = Array(3, 5, 10, 15, 20, 30, 40, 50, 60, 80, 100, 150, 200, 250, 300, 350, 400) 'cao do z
arr1(0) = 3
Dim arr2()
arr2 = Array(1, 1.07, 1.18, 1.24, 1.29, 1.37, 1.43, 1.47, 1.51, 1.57, 1.62, 1.72, 1.79, 1.84, 1.84, 1.84, 1.84) 'dia hinh A
arr2(0) = 1
Dim arr3()
arr3 = Array(0.8, 0.88, 1, 1.08, 1.13, 1.22, 1.28, 1.34, 1.38, 1.45, 1.51, 1.63, 1.71, 1.78, 1.84, 1.84, 1.84) 'dia hinh B
arr3(0) = 0.8
Dim arr4()
arr4 = Array(0.47, 0.54, 0.66, 0.74, 0.8, 0.89, 0.97, 1.03, 1.08, 1.18, 1.25, 1.4, 1.52, 1.62, 1.7, 1.78, 1.84) 'dia hinh C
arr4(0) = 0.47
Dim i As Long, x1 As Double, x3 As Double, y1 As Double, y3 As Double
For i = 0 To 16
If arr1(i) <= caodo And arr1(i + 1) >= caodo Then
Exit For
Else
End If
Next i
x1 = arr1(i)
x3 = arr1(i + 1)
If diahinh = "A" Then
y1 = arr2(i)
y3 = arr2(i + 1)
ElseIf diahinh = "B" Then
y1 = arr3(i)
y3 = arr3(i + 1)
ElseIf diahinh = "C" Then
y1 = arr4(i)
y3 = arr4(i + 1)
End If
noisuykz = (y3 * (caodo - x1) + y1 * (x3 - caodo)) \ (x3 - x1)
End Function

 

[snow25]

Em mới tập tành viết code VBA và có viết thử hàm nội suy 1 chiều dùng mảng ạ nhưng mà không hiểu sao khi nội suy xong giá trị của nó tính ra lại bằng 1 hoặc bằng 0, trong khi em dùng công thức đó tính tay thử kết quả lại ra đúng với lại em xem các giá trị của biến trên cửa sổ Local thì gán đều đúng mà không hiểu sao lại lại không nội suy được mong được các anh chị trên diễn đàn giúp đỡ tìm lỗi em cảm ơn ạ.
Function noisuykz(diahinh As String, caodo As Double) As Double
Dim arr1()
arr1 = Array(3, 5, 10, 15, 20, 30, 40, 50, 60, 80, 100, 150, 200, 250, 300, 350, 400) 'cao do z
arr1(0) = 3
Dim arr2()
arr2 = Array(1, 1.07, 1.18, 1.24, 1.29, 1.37, 1.43, 1.47, 1.51, 1.57, 1.62, 1.72, 1.79, 1.84, 1.84, 1.84, 1.84) 'dia hinh A
arr2(0) = 1
Dim arr3()
arr3 = Array(0.8, 0.88, 1, 1.08, 1.13, 1.22, 1.28, 1.34, 1.38, 1.45, 1.51, 1.63, 1.71, 1.78, 1.84, 1.84, 1.84) 'dia hinh B
arr3(0) = 0.8
Dim arr4()
arr4 = Array(0.47, 0.54, 0.66, 0.74, 0.8, 0.89, 0.97, 1.03, 1.08, 1.18, 1.25, 1.4, 1.52, 1.62, 1.7, 1.78, 1.84) 'dia hinh C
arr4(0) = 0.47
Dim i As Long, x1 As Double, x3 As Double, y1 As Double, y3 As Double
For i = 0 To 16
If arr1(i) <= caodo And arr1(i + 1) >= caodo Then
Exit For
Else
End If
Next i
x1 = arr1(i)
x3 = arr1(i + 1)
If diahinh = "A" Then
y1 = arr2(i)
y3 = arr2(i + 1)
ElseIf diahinh = "B" Then
y1 = arr3(i)
y3 = arr3(i + 1)
ElseIf diahinh = "C" Then
y1 = arr4(i)
y3 = arr4(i + 1)
End If
noisuykz = (y3 * (caodo - x1) + y1 * (x3 - caodo)) \ (x3 - x1)
End Function

Tôi thấy cái công thức nó bị sao đó.Bạn thử cái này xem.

noisuykz = (y3 * (caodo - x1) + y1 * (x3 - caodo)) / (x3 - x1)

 

[VetMini]

\ là phép chia số nguyên.
Bài toán của bạn dùng tất cả đối số, thừa số là số thực. Lý do tại sao lại chia số nguyên?

 

[Khanh199x]

Tôi thấy cái công thức nó bị sao đó.Bạn thử cái này xem.

noisuykz = (y3 * (caodo - x1) + y1 * (x3 - caodo)) / (x3 - x1)

Em làm được rồi cảm ơn anh chỗ phép chia em bị sai

Bài đã được tự động gộp: 27/7/19

\ là phép chia số nguyên.
Bài toán của bạn dùng tất cả đối số, thừa số là số thực. Lý do tại sao lại chia số nguyên?

Dạ em đã nhận ra chỗ sai rồi cảm ơn anh đã nhắc nhở

 

[quocturtle]

Xin chào mọi người
Mình có đoạn code sau hiện ko hiểu sai chỗ nào.
Objective: dời giá trí 1 cột lên t dòng.
Vd:
A1: 1
A2: 2
A3: A
A4: B

Function(A1:A4,2) <-- chọn xuất kết quả từ B1:B4
B1: A
B2: B
B3: 1
B4: 2

Cơ bản là thế. Đoạn code của mình:

Option Explicit
Option Base 1


Function ShiftVector(rng As Range, n As Integer) As Variant
Dim i As Integer, t As Integer
Dim A() As Variant
Dim nrow As Integer

nrow = rng.Rows.Count
n = n Mod nrow

ReDim A(nrow) As Variant

For i = 1 To nrow
    t = (i + n) Mod nrow
    If t = 0 Then t = nrow
    A(i) = rng(t)
Next i

ShiftVector = A

End Function

Vấn đề: Vd nếu function(A1:A4,2) thì cột B mình xuất ra toàn giá trị 1. Mình ko biết sai chỗ nào

Cảm ơn mọi người

 

[VetMini]

Code của bạn nó không hẳn đi sát với "objective" của bạn (hy vọng rằng khi dùng từ này, bạn hiểu rõ nó là gì)
Khi nói về cột và dòng, người ta nói về array. Hàm của bạn nó mang tên vector.
Khác với vector, mảng (array) trong VBA xác định chiều rất rõ rệt.
Nếu bạn muốn làm việc với array thì xem lại cách định chiều trong code.

 

[snow25]

Xin chào mọi người
Mình có đoạn code sau hiện ko hiểu sai chỗ nào.
Objective: dời giá trí 1 cột lên t dòng.
Vd:
A1: 1
A2: 2
A3: A
A4: B

Function(A1:A4,2) <-- chọn xuất kết quả từ B1:B4
B1: A
B2: B
B3: 1
B4: 2

Cơ bản là thế. Đoạn code của mình:

Option Explicit
Option Base 1


Function ShiftVector(rng As Range, n As Integer) As Variant
Dim i As Integer, t As Integer
Dim A() As Variant
Dim nrow As Integer

nrow = rng.Rows.Count
n = n Mod nrow

ReDim A(nrow) As Variant

For i = 1 To nrow
    t = (i + n) Mod nrow
    If t = 0 Then t = nrow
    A(i) = rng(t)
Next i

ShiftVector = A

End Function

Vấn đề: Vd nếu function(A1:A4,2) thì cột B mình xuất ra toàn giá trị 1. Mình ko biết sai chỗ nào

Cảm ơn mọi người

Bạn thử cái này xem có đúng không.

Function chuyen(ByVal mang As Range, ByVal so As Integer)
        Dim kq() As String, i As Long, arr, a As Long
        arr = mang.Value
        ReDim kq(1 To UBound(arr), 1 To 1)
        a = so Mod UBound(arr)
        For i = 1 To UBound(arr)
            a = a + 1
            If a > UBound(arr) Then a = 1
            kq(i, 1) = arr(a, 1)
       Next i
       chuyen = kq
End Function

 

[VetMini]

Bạn thử cái này xem có đúng không.

Function chuyen(ByVal mang As Range, ByVal so As Integer)
        Dim kq() As String, i As Long, arr, a As Long
        arr = mang.Value
        ReDim kq(1 To UBound(arr), 1 To 1)
        a = so Mod UBound(arr)
        For i = 1 To UBound(arr)
            a = a + 1
            If a > UBound(arr) Then a = 1
            kq(i, 1) = arr(a, 1)
       Next i
       chuyen = kq
End Function

Code hơi cẩu thả. Tiết kiệm 1 biến, để rồi tính UBound đến mấy lần?

 

[quocturtle]

Xin chào mọi người, mình đang có chút thắc mắc về cách select để xuất dữ liệu bằng VBA
Cái này chắc ko mới nhưng mình ko biết key word phải kiếm thế nào nên bạn nào rành giúp mình với

Ví dụ hàm mình tùy thuộc vào dữ liệu đầu vào, đầu ra là một ma trận n x 1. Thì khi mình muốn xuất dữ liệu đầu ra thì trick là:
Range("A1:A"&n)

Còn ví dụ như nếu đầu ra của mình là ma trận (n x m) Để làm tương tự như trên thì mình viết thế nào cho đúng.
Cách giải quyết của mình hơi bị dài, cụ thể là
1. Viết một function phụ alphabettonumber trong đó quy định A = 1, B = 2, ...
2. Tính toán nội suy ra giá trị x. Ví dụ như m = 3 thì x = C
3. Range("A1:" & x & n)
Làm theo hướng của mình thì rắc rối quá, mình nghĩ trong VBA sẽ có build in function / trick giúp chuyện này dễ hơn

Mong mọi người giúp
Cảm ơn

 

[snow25]

Xin chào mọi người, mình đang có chút thắc mắc về cách select để xuất dữ liệu bằng VBA
Cái này chắc ko mới nhưng mình ko biết key word phải kiếm thế nào nên bạn nào rành giúp mình với

Ví dụ hàm mình tùy thuộc vào dữ liệu đầu vào, đầu ra là một ma trận n x 1. Thì khi mình muốn xuất dữ liệu đầu ra thì trick là:
Range("A1:A"&n)

Còn ví dụ như nếu đầu ra của mình là ma trận (n x m) Để làm tương tự như trên thì mình viết thế nào cho đúng.
Cách giải quyết của mình hơi bị dài, cụ thể là
1. Viết một function phụ alphabettonumber trong đó quy định A = 1, B = 2, ...
2. Tính toán nội suy ra giá trị x. Ví dụ như m = 3 thì x = C
3. Range("A1:" & x & n)
Làm theo hướng của mình thì rắc rối quá, mình nghĩ trong VBA sẽ có build in function / trick giúp chuyện này dễ hơn

Mong mọi người giúp
Cảm ơn

Bạn thử cái này. Range("A1").resize(n,x).value=mảng đó kiểu như vậy.

 

[VetMini]

...Làm theo hướng của mình thì rắc rối quá, mình nghĩ trong VBA sẽ có build in function / trick giúp chuyện này dễ hơn

Mong mọi người giúp
Cảm ơn

trick là xảo thuật.
rule/procedure/method mới là cách thức. Trong khi đó, kỹ thuật là technique.
Muốn hỏi xảo thuật, kỹ thuật, hay cách thức?

 

[quocturtle]

Bạn thử cái này. Range("A1").resize(n,x).value=mảng đó kiểu như vậy.

Cảm ơn bạn nhiều

 

[tuan.chemi]

cho em hỏi sao cái này nó không cho ra kết quả đúng của hệ ạ. khi chạy code thì nó hiện thị lỗi. anh chị giúp em với ạ

 

[quocturtle]

Xin chào mọi người
Mình có chút thắc mắc về input cho Textbox trong UserForm
Cho mình hỏi có cách nào set Textbox:
1. Chỉ nhận giá trị số khi đang nhập
2. Tự động điền dấu phẩy cho mỗi ba số được nhập vào

Hai cái trên mình muốn nó theo thời gian thực (real time). Tức nghĩ là:
Giả sử 1: mình nhập "123a" thì khi nhập tới a nó báo error message. Vd "Chỉ nhâp số"
Giả sử 2: mình nhập "123456789" thì khi mình nhập tới số "4", "7" thì trong box tự động điền dấu ","

Nếu làm theo kiểu bị động thì mình làm được. (Bị động tức nhập xong, rồi bấm CommandButton) chạy sub check thì ok rồi. Nhưng làm theo kiểu real-time update này thì mình ko biết làm sao

Anh/chị/em nào cao tay giúp mình một tay với
Cảm ơn

 

[VetMini]

...Nếu làm theo kiểu bị động thì mình làm được. (Bị động tức nhập xong, rồi bấm CommandButton) chạy sub check thì ok rồi. Nhưng làm theo kiểu real-time update này thì mình ko biết làm sao
...

Bạn muốn nhập nó vào mảng hay nhập mảng vào nó?

 

[quocturtle]

Bạn muốn nhập nó vào mảng hay nhập mảng vào nó?

Ah ý mình là muốn nhập vô vậy nè
Cái 1. Thì mình làm lệnh TextBoxF.Value = Format(TextBoxF.Value, "#,###") có vẻ giải quyết được vấn đề
Còn cái 2. Mình dùng If IsNumeric(TextBoxF.Value) = False Then MsgBox "It must be number" thì kiểu bị phải chọn ok 2 lần ấy
Ví dụ mình nhập "123a" Thì nó hiện ra cái Msgbox bắt nhấn ok hai lần rồi mới cho nhập lại :| Kiểu tới đây mình ko biết là tại sao luôn ấy :|

 

[snow25]

View attachment 222580

Ah ý mình là muốn nhập vô vậy nè
Cái 1. Thì mình làm lệnh TextBoxF.Value = Format(TextBoxF.Value, "#,###") có vẻ giải quyết được vấn đề
Còn cái 2. Mình dùng If IsNumeric(TextBoxF.Value) = False Then MsgBox "It must be number" thì kiểu bị phải chọn ok 2 lần ấy
Ví dụ mình nhập "123a" Thì nó hiện ra cái Msgbox bắt nhấn ok hai lần rồi mới cho nhập lại :| Kiểu tới đây mình ko biết là tại sao luôn ấy :|

Cho cái kiểm tra số lên trước khi nào mà nó báo không phải dạng số exit sub luôn là được.Nó sẽ không chạy cái format hiểu không ta.

 

[VetMini]

Cho cái kiểm tra số lên trước khi nào mà nó báo không phải dạng số exit sub luôn là được.Nó sẽ không chạy cái format hiểu không ta.

Hình như câu hỏi ở bài #1284 không ăn khớp với vấn đề ở bài #1286. Và cả hai vấn đề đều không thấy chỗ liên quan đến mảng.

Tác giả câu hỏi:
1. Đây là thớt thắc mắc về mảng. Vấn đề của bạn đâu có dính dáng gì đến mảng?
2. Tiếng Việt và tiếng Anh đối với bạn cái nào dễ nói hơn. Nếu viết thuần tiếng Anh, may ra tôi hiểu được.
Which is more natural to you, Vietnamese or English? Perhaps I could understand better if you have your question presented in plain English.

 

[ongke0711]

Cho mình hỏi có cách nào set Textbox:
1. Chỉ nhận giá trị số khi đang nhập
...
Hai cái trên mình muốn nó theo thời gian thực (real time). Tức nghĩ là:
Giả sử 1: mình nhập "123a" thì khi nhập tới a nó báo error message. Vd "Chỉ nhâp số"
...

Để chỉ cho phép nhập số không thôi thì bạn dùng sự kiện KeyPress.
Ví dụ:

Private Sub txtTextBox1_KeyPress(ByVal KeyAscii As MSForms.ReturnInteger)
If KeyAscii >= 48 And KeyAscii <= 57 Then
    'OK - dang nhap so
Else
    KeyAscii = 0
End If
End Sub

 

[befaint]

Để chỉ cho phép nhập số không thôi thì bạn dùng sự kiện KeyPress.
Ví dụ:

Private Sub txtTextBox1_KeyPress(ByVal KeyAscii As MSForms.ReturnInteger)
If KeyAscii >= 48 And KeyAscii <= 57 Then
    'OK - dang nhap so
Else
    KeyAscii = 0
End If
End Sub

Để nhập số có phần thập phân và số âm thì làm như nào anh.
Ví dụ nhập số -2.6 (âm hai phẩy sáu).

 

[ongke0711]

Để nhập số có phần thập phân và số âm thì làm như nào anh.
Ví dụ nhập số -2.6 (âm hai phẩy sáu).

Thêm mã ASCII 45,46 vô. Đổi qua dùng Select Case.

Private Sub txtTextBox1_KeyPress(ByVal KeyAscii As MSForms.ReturnInteger)
Select Case KeyAscii
Case 48 to 57
    'OK - dang nhap so
Case 45,46
    ' dau -,.
Case Else
    KeyAscii = 0
End Select
End Sub

 

[befaint]

Thêm mã ASCII 45,46 vô. Đổi qua dùng Select Case.

Private Sub txtTextBox1_KeyPress(ByVal KeyAscii As MSForms.ReturnInteger)
Select Case KeyAscii
Case 48 to 57
    'OK - dang nhap so
Case 45,46
    ' dau -,.
Case Else
    KeyAscii = 0
End Select
End Sub

Có cách nào để mình chỉ nhập được một dấu trừ, một dấu chấm không anh.

 

[ongke0711]

Có cách nào để mình chỉ nhập được một dấu trừ, một dấu chấm không anh.

View attachment 222586

Tại gõ nhanh nhanh đi công việc chứ đúng ra còn bẫy lỗi trên nữa. Dùng Instr() để bắt lỗi vị trí dấu - và dấu chấm. Haha...gặp thánh soi... ^,

Private Sub TextBox1_KeyPress(ByVal KeyAscii As MSForms.ReturnInteger)
    Select Case KeyAscii
    Case 48 To 57
    Case 45
        If InStr(1, TextBox1.Text, "-") > 0 Or Me.TextBox1.SelStart > 0 Then
            KeyAscii = 0
        End If
    Case 46
        If InStr(1, Me.TextBox1.Text, ".") > 0 Then
            KeyAscii = 0
        End If
    Case Else
        KeyAscii = 0
    End Select
End Sub

 

[befaint]

Haha...gặp thánh soi...

Còn như này thì chỉnh sao anh. Hê hê.

 

[ongke0711]

Còn như này thì chỉnh sao anh. Hê hê.

View attachment 222588

Lần này chắc hết lỗi rồi.

Private Sub TextBox1_KeyPress(ByVal KeyAscii As MSForms.ReturnInteger)
    Select Case KeyAscii
    Case 48 To 57
    Case 45
        If InStr(1, TextBox1.Text, "-") > 0 Or TextBox1.SelStart > 0 Then
            KeyAscii = 0
        End If
    Case 46
        If Me.TextBox1.SelStart = 0 Then KeyAscii = 0
        If InStr(1, TextBox1.Text, "-") = 1 And TextBox1.SelStart = 1 Then KeyAscii = 0
        If InStr(1, TextBox1.Text, ".") > 0 Then KeyAscii = 0
    Case Else
        KeyAscii = 0
    End Select
End Sub

 

[VetMini]

Có cách nào để mình chỉ nhập được một dấu trừ, một dấu chấm không anh.
...

Chuyển đổi đơn vị mắc mớ gì phải nhận số âm.

Ngoài ra:
Người ta còn muốn chuyển dạng #,### nữa.
Nếu chỉ nhập 1 lần thì không sao. Nhưng nếu nhập, xong quay lại chỉnh thêm thì bắt buộc phải xét các trường hợp #,##,##,# vân vân
(cách dễ nhất là xoá hết các dấu phẩy, xét xong rồi thêm vào trở lại)

Chả biết tại sao chuyển đổi đơn vị mà cũng phải xét realtime [sic] cho nó mệt.

 

[befaint]

Chuyển đổi đơn vị mắc mớ gì phải nhận số âm.

Mấy bài em hỏi không liên quan tới bài #1286 đâu anh.

Bài đã được tự động gộp: 9/8/19

Lần này chắc hết lỗi rồi.

Khi chưa có số nào mà mình ấn dấm chấm mà tự điền số 0 thì hay hơn. Như trên máy tính đó anh (với những số 0.123 thì rất ít khi em gõ số 0, mà gõ luôn dấu chấm).

 

[ongke0711]

Khi chưa có số nào mà mình ấn dấm chấm mà tự điền số 0 thì hay hơn. Như trên máy tính đó anh (với những số 0.123 thì rất ít khi em gõ số 0, mà gõ luôn dấu chấm).

Tôi có nghĩ vụ này nhưng ý là muốn để cho sự kiện khác của Textbox xử lý (Exit, AfterUpdate...), bao gồm các xử lý định dạng khác luôn.

 

[quocturtle]

Cho cái kiểm tra số lên trước khi nào mà nó báo không phải dạng số exit sub luôn là được.Nó sẽ không chạy cái format hiểu không ta.

He he thanks bạn, chuyển lên đúng là giải quyết được thật

 

[quocturtle]

Chào mọi người
Giả sử mình muốn tạo một loạt biến với tên gọi là X01, X02, X03, etc. thì trong VBA cách làm này phải thế nào vậy mọi người.
Thật ra làm thủ công kiểu tạo 1,000 biến X001, X002, X003 thì thì mình có thể dùng string nối lại trong Excel rồi copy paste qua VBA. Mà kiểu này thì mình thấy giống chống cháy thôi

Cảm ơn mọi người

 

[VetMini]

Đó là nhiệm vụ của một cái từ khoá tên là Dim
Dim X(1 to 1000)
Khi ấy:
X(1) là cái X001 mà bạn muốn
X(1000) là cái X1000

 

[quocturtle]

Đó là nhiệm vụ của một cái từ khoá tên là Dim
Dim X(1 to 1000)
Khi ấy:
X(1) là cái X001 mà bạn muốn
X(1000) là cái X1000

Ah cảm ơn bạn nhiều
Mình thường sử dụng nhiều với ma trận. Dim như vậy thì tạo dimension cho nó thế nào bạn.
Ví dụ
- X(1) size(2x2)
- X(2) size(4x5)
- etc.

Tại vì mỗi biến X(i) thì size thay đổi (mxn) nên mình lại đang kẹt vụ này
Mình thử
Dim X(1 to 10)
Redim X(1,2,2)
Redim X(2,5,6)
etc
Thì VBA báo sai

 

[HieuCD]

Ah cảm ơn bạn nhiều
Mình thường sử dụng nhiều với ma trận. Dim như vậy thì tạo dimension cho nó thế nào bạn.
Ví dụ
- X(1) size(2x2)
- X(2) size(4x5)
- etc.

Tại vì mỗi biến X(i) thì size thay đổi (mxn) nên mình lại đang kẹt vụ này
Mình thử
Dim X(1 to 10)
Redim X(1,2,2)
Redim X(2,5,6)
etc
Thì VBA báo sai

Dim X(1 to 10)
dim a(2,2)
x(1)=a
dim a(5,6)
X(2)=a
etc

 

[quocturtle]

Dim X(1 to 10)
dim a(2,2)
x(1)=a
dim a(5,6)
X(2)=a
etc

Đúng rồi, mình cũng đang dùng cách chống cháy này
Mình còn cách nào khác ko bạn

 

[HieuCD]

Đúng rồi, mình cũng đang dùng cách chống cháy này
Mình còn cách nào khác ko bạn

Chỉ biết bấy nhiêu thôi

 

[VetMini]

Ah cảm ơn bạn nhiều
Mình thường sử dụng nhiều với ma trận. Dim như vậy thì tạo dimension cho nó thế nào bạn.
Ví dụ
- X(1) size(2x2)
- X(2) size(4x5)
- etc.

Tại vì mỗi biến X(i) thì size thay đổi (mxn) nên mình lại đang kẹt vụ này
Mình thử
Dim X(1 to 10)
Redim X(1,2,2)
Redim X(2,5,6)
etc
Thì VBA báo sai

Tiếng Việt, cái đó không phải là ma trận.
Tôi có yêu cầu rằng nếu bạn giỏi tiếng Anh hơn tiếng Việt thì dùng thẳng tiếng Anh, tôi trả lời dễ hơn.
Tiếng Anh, cái đó gọi là jagged array; nếu dịch ra tiếng Việt thì là mảng răng cưa (không đều).
VBA thể hiện dạng này theo cấu trúc mảng trong mảng.
Đây là lần cuối tôi trả lời cho câu hỏi nửa Tây nửa Ta.

 

[quocturtle]

Tiếng Việt, cái đó không phải là ma trận.
Tôi có yêu cầu rằng nếu bạn giỏi tiếng Anh hơn tiếng Việt thì dùng thẳng tiếng Anh, tôi trả lời dễ hơn.
Tiếng Anh, cái đó gọi là jagged array; nếu dịch ra tiếng Việt thì là mảng răng cưa (không đều).
VBA thể hiện dạng này theo cấu trúc mảng trong mảng.
Đây là lần cuối tôi trả lời cho câu hỏi nửa Tây nửa Ta.

Cảm ơn bạn nhiều
Nếu cách mình diển đạt làm phiền bạn thì mình xin lỗi bạn nhiều. Nhưng mà bạn ơi, trình độ mình có hạn. Lúc diễn đạt thì mình diển đạt theo cái mà mình biết và mình hiểu. Nêu đã biết tên gọi đúng cái đó là mảng răng cưa như bạn nói thì mình cũng ko phải diển đạt lòng vòng vậy đâu.

 

[VetMini]

Dim X(1 to 10)
dim a(2,2)
x(1)=a
dim a(5,6)
X(2)=a
etc

Đây là nhiệm vụ của cái tên biến mà các bạn vẫn hay dùng: tmp, tem, temp
Dim X(1 to ...), tmp ' nếu dùng tên tmpArr thì có thể khai luôn là tmpArr() để ngừoi đọc hiểu ngay nó phải luôn là Array
Redim tmp(1 to 100)
X(1) = tmp
...

 

[truongvu317]

VBA thể hiện dạng này theo cấu trúc mảng trong mảng.

Giả sử cháu có một mảng tượng trưng cho các lớp học của một trường học nào đó, trong mỗi lớp học có các học sinh. Ví dụ như mangLopHocs(1)(2) là tên học sinh ở vị trí thứ 2 của lớp học 1 ( xét trong điều kiện tất cả đều là mảng một chiều). Cho cháu hỏi là nếu giờ cháu muốn duyệt các học sinh của một lớp nào đó thì phương án:
1, duyệt theo kiểu mangLopHocs(1)(x), với x là chỉ số.
2, gán mangLopHocs(1) vào một mảng nào đó rồi duyệt như bình thường.
Thì phương án 1 hay 2 sẽ nhanh và thuật tiện hơn.
Nếu bây giờ muốn thêm hoặc xóa một học sinh ( ý là định cỡ lại mảng danh sách học sinh) thì làm thế nào?

 

[VetMini]

Tôi không hiểu lắm yêu cầu của bạn. Mảng răng cưa chỉ dùng khi các phần tử không giống nhau. Tổ chức lớp học và học sinh thì đồng bộ.
Nếu tôi đoán không lầm thì cái bạn muốn cần phải dùng mảng 3 chiều:
Chiều 1 = lớp
Chiều 2 = học sinh
Chiều 3 = chi tiết học sinh
Ví dụ:
mangLopHS(1, 2, 1) = "Nguyễn Văn A"
mangLopHS(1, 2, 2) = 2010
mangLopHS(1, 2, 3) = ...
Đọc ra là "gán tên Nguyễn Văn A và năm sinh 2010 cho em học sinh thứ 2 trong lớp thứ nhất"
Đương nhiên với cấu trúc này, bạn phải có thêm một mảng Lop() cho biết chi tiết của lớp 1, 2, ...

Tuy nhiên, đó là cách thiết kế cấu trúc cổ điển, vì là mảng cho nên lúc xoá, bạn chỉ có thể xoá rồi dồn lên. Lúc thêm thì cũng vậy. Và vì vậy cho nên bạn phải đặt độ lớn của mảng trước.
Cách dễ hơn hết là dùng collection.

Nếu sẵn sàng dùng .NET thì có thể dùng các loại mảng động như ArrayList.

Cách thiết kế tường minh hơn 1 chút là dùng type
Type HocSinh
ten As String
namSinh As Integer
...
End Type
...
Dim mangLopHS() As HocSinh
mangLopHS(1).ten = "Nguyễn Văn A"
mangLopHS(1).namSinh = 2010
mangLopHS(1)... = ...

Và nếu bạn chịu khó cốt kiếc chút nữa thì có thể dùng Class.

 

[truongvu317]

Tôi không hiểu lắm yêu cầu của bạn. Mảng răng cưa chỉ dùng khi các phần tử không giống nhau. Tổ chức lớp học và học sinh thì đồng bộ.
Nếu tôi đoán không lầm thì cái bạn muốn cần phải dùng mảng 3 chiều:
Chiều 1 = lớp
Chiều 2 = học sinh
Chiều 3 = chi tiết học sinh
Ví dụ:
mangLopHS(1, 2, 1) = "Nguyễn Văn A"
mangLopHS(1, 2, 2) = 2010
mangLopHS(1, 2, 3) = ...
Đọc ra là "gán tên Nguyễn Văn A và năm sinh 2010 cho em học sinh thứ 2 trong lớp thứ nhất"
Đương nhiên với cấu trúc này, bạn phải có thêm một mảng Lop() cho biết chi tiết của lớp 1, 2, ...

Tuy nhiên, đó là cách thiết kế cấu trúc cổ điển, vì là mảng cho nên lúc xoá, bạn chỉ có thể xoá rồi dồn lên. Lúc thêm thì cũng vậy. Và vì vậy cho nên bạn phải đặt độ lớn của mảng trước.
Cách dễ hơn hết là dùng collection.

Nếu sẵn sàng dùng .NET thì có thể dùng các loại mảng động như ArrayList.

Cách thiết kế tường minh hơn 1 chút là dùng type
Type HocSinh
ten As String
namSinh As Integer
...
End Type
...
Dim mangLopHS() As HocSinh
mangLopHS(1).ten = "Nguyễn Văn A"
mangLopHS(1).namSinh = 2010
mangLopHS(1)... = ...

Và nếu bạn chịu khó cốt kiếc chút nữa thì có thể dùng Class.

Dùng cái Type thì code sáng sủa, đỡ mắc viết nhầm.

Nêu ra vấn đề học sinh cho bác dễ tưởng tượng thôi, chứ cháu đang muốn hỏi liên quan tới kỹ thuật dùng mảng trong mảng, xem quá trình đọc viết các dữ liệu trong mảng con, cũng như quá trình thao tác mảng con ( ví dụ như redim, erase...)

Ps: Mảng con là cái mảng nằm trong mảng cha, mangLopHS(1) là mảng con của mảng mangLopHS.

 

[VetMini]

Dùng cái Type thì code sáng sủa, đỡ mắc viết nhầm.

Nêu ra vấn đề học sinh cho bác dễ tưởng tượng thôi, chứ cháu đang muốn hỏi liên quan tới kỹ thuật dùng mảng trong mảng, xem quá trình đọc viết các dữ liệu trong mảng con, cũng như quá trình thao tác mảng con ( ví dụ như redim, erase...)

Ps: Mảng con là cái mảng nằm trong mảng cha, mangLopHS(1) là mảng con của mảng mangLopHS.

Nếu là ngôn ngữ khác thì ngừoi ta đã dùng danh sách kết nối (linked list). Tuy nhiên, VBA không có dạng cấu trúc này cho nên dùng mảng khá luộm thuộm.
Nên nhớ rằng ưu điểm của mảng là dãy liền kề nhau khiến cho việc truy cập cũng như lô gic truy cập rất hiệu quả. Mặt khác nó cũng là khuyết điểm vì nó khiến cho việc thêm bớt phần tử rất rối rắm.
Dữ liệu "Liền kề nhau" được thể hiện theo dạng mà tiếng nghề gọi là "sequential".

Theo như yêu cầu của bạn, chúng ta THỬ VÍ DỤ rằng bắt buộc phải thiết kế theo cấu trúc mảng, và không muốn kiểu đơn giản mảng nhiều chiều. Lúc ấy cách thiết kế của tôi sẽ như vầy:
- Đặt một mảng LopHoc(0 To soLopHoc); soLopHoc là số lớp học.
- Mảng này có phần tử đầu tiên, LopHoc(0), là một mảng chi tiết các lớp học. LopHoc(0) được Dim là (1 To soLopHoc). Phần tử i liên quan đến lớp học i. Ví dụ LopHoc(0)(1) chứa chi tiết lớp học 1.
- Với i > 0 thì phần tử LopHoc(i) là mảng chứa học sinh. LopHoc(i)(j) là học sinh j trong lớp i.
Theo cấu trúc này thì bạn có thể dùng sequential cho lớp học. Mỗi lần thêm thì thêm HS ở cuối và mõi lần xoá thì dồn lên. Cả hai đều có thể Redim Preserved mảng.

Nếu dùng dạng mảng 3 chiều (hay nhiều chiều hơn) như tôi nói ở bài trước thì bạn không thể Redim Preserved mảng, và bắt buộc phải đặt trước kích cỡ của mảng lớn hơn dự định dùng. Với cách này, bạn nên có một mảng song với với mảng kia để cho biết mỗi chiều đã sử dụng đến bao nhiêu phần tử.

 

[truongvu317]

Cả hai đều có thể Redim Preserved mảng.

Lúc đó mình copy nội dung mạng con ra một mảng khác, sau đó redim Preserved và cuối cùng là ghi lại mảng đó vào mảng cũ?

 

[VetMini]

Lúc đó mình copy nội dung mạng con ra một mảng khác, sau đó redim Preserved và cuối cùng là ghi lại mảng đó vào mảng cũ?

Thì cứ vậy, mấy tầng thì làm đủ bấy tầng. Nếu muốn thực hiện thì tốt hơn hết nên viết một hàm/sub chuyên làm công việc chép và redim. Tuy nó không làm công việc hiệu quả hơn nhưng ít nhất cũng giúp cho code dễ đọc hơn.
Tôi có nói là cấu trúc mảng không thích hợp với ví dụ này mờ.

 

[Hoàng Nhật Phương]

Xin chào các bạn,
OT muốn so sánh dữ liệu trong từ cột A:E trong 2 sheets("old") và sheets("new") và trả về kết quả khác nhau tại cột E sheets("Results")
Đoạn code dưới đây OT sưu tầm chỉ so sánh được cột A, mong các bạn sửa giúp trường hợp so sánh A:E ạ.

Option Explicit
Sub NoMatches()
    'https://www.thesmallman.com/compare-two-worksheets
    Dim dic As Object, ar As Variant, ar1 As Variant
    Dim var As Variant, i As Long, n As Long
    Dim shCu As Worksheet, shMoi As Worksheet, shKQ As Worksheet
   
    Set shCu = ThisWorkbook.Worksheets("OLD")
    Set shMoi = ThisWorkbook.Worksheets("NEW")
    Set shKQ = ThisWorkbook.Worksheets("Results")
   
    Set dic = CreateObject("Scripting.Dictionary")
    dic.CompareMode = 1
    ar = shCu.Range("A2", shCuRange("A" & Rows.Count).End(xlUp)).Value
    var = shMoi.Range("A2", shMoi.Range("A" & Rows.Count).End(xlUp)).Value
    ReDim ar1(1 To UBound(var), 1 To 1)
    For i = 1 To UBound(ar)
        If Not dic.exists(ar(i, 1)) Then
            dic.Add ar(i, 1), ar(i, 1)
        End If
    Next i
    For i = 1 To UBound(var)
        If Not dic.exists(var(i, 1)) Then
            n = n + 1
            ar1(n, 1) = var(i, 1)
        End If
    Next i
   
    shKQ.Range("E2:E" & UBound(var)).Value = ar1
    shKQ.Range("E2:E" & UBound(var)).RemoveDuplicates 1
   
End Sub

 

[Ba Tê]

Xin chào các bạn,
OT muốn so sánh dữ liệu trong từ cột A:E trong 2 sheets("old") và sheets("new") và trả về kết quả khác nhau tại cột E sheets("Results")
Đoạn code dưới đây OT sưu tầm chỉ so sánh được cột A, mong các bạn sửa giúp trường hợp so sánh A:E ạ.

Option Explicit
Sub NoMatches()
    'https://www.thesmallman.com/compare-two-worksheets
    Dim dic As Object, ar As Variant, ar1 As Variant
    Dim var As Variant, i As Long, n As Long
    Dim shCu As Worksheet, shMoi As Worksheet, shKQ As Worksheet
  
    Set shCu = ThisWorkbook.Worksheets("OLD")
    Set shMoi = ThisWorkbook.Worksheets("NEW")
    Set shKQ = ThisWorkbook.Worksheets("Results")
  
    Set dic = CreateObject("Scripting.Dictionary")
    dic.CompareMode = 1
    ar = shCu.Range("A2", shCuRange("A" & Rows.Count).End(xlUp)).Value
    var = shMoi.Range("A2", shMoi.Range("A" & Rows.Count).End(xlUp)).Value
    ReDim ar1(1 To UBound(var), 1 To 1)
    For i = 1 To UBound(ar)
        If Not dic.exists(ar(i, 1)) Then
            dic.Add ar(i, 1), ar(i, 1)
        End If
    Next i
    For i = 1 To UBound(var)
        If Not dic.exists(var(i, 1)) Then
            n = n + 1
            ar1(n, 1) = var(i, 1)
        End If
    Next i
  
    shKQ.Range("E2:E" & UBound(var)).Value = ar1
    shKQ.Range("E2:E" & UBound(var)).RemoveDuplicates 1
  
End Sub

Đọc code rồi "mơ màng" ra kết quả.
Sao kiểm chứng được "đúng sai là sự thật"?

 

[Hoàng Nhật Phương]

Đọc code rồi "mơ màng" ra kết quả.
Sao kiểm chứng được "đúng sai là sự thật"?

Con chào Thầy ạ,
Cảm ơn Thầy đã đã quan tâm ạ, con gửi file kèm nhờ Thầy và mọi người xem giúp ạ.

 

[Ba Tê]

Con chào Thầy ạ,
Cảm ơn Thầy đã đã quan tâm ạ, con gửi file kèm nhờ Thầy và mọi người xem giúp ạ.

Vẫn mơ hồ.
- 2 sheet xét theo từng dòng từ cột A đến E?
- Nếu từng Cell có giá trị của 2 sheet khác nhau thì "tô màu", vậy nội dung trong cell kết quả ghi nội dung của sheet 1 hay sheet2?
- Cũng giải thích rõ kết quả trong sheet Result: E2, G2, I2 làm sao mà có? Quy luật là sao?