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ị
Em lại có ví dụ sau để học mảng
- Sheet 1 có dữ liệu từ A1:C10
- Trong một hàng dữ liệu (ví dụ từ A1:C1) chỉ được nhận là trống hết, nếu đã điền, thì phải điền đủ dữ liệu
Ví dụ: - TH1: Điền hết dữ liệu
Cột A------Cột B----------Cột C
TM..... 09/03/2012--------201203 - TH2: để trống hết
Cột A------Cột B----------Cột C
..............................................
Yêu cầu
Dùng mảng để duyệt những dòng điền dữ liệu không đủ
Em có đoạn code sau như nó báo lỗi "Object required"
PHP:
Sub blank()
Dim sArr()
sArr = Sheet1.Range("A1:A10").Value
For i = 1 To UBound(sArr)
If WorksheetFunction.CountBlank(sArr(i, 1).Resize(, 3)) <> 3 Then
MsgBox "Sheet1 dong thu" & i & " chua dien du thong tin "
End If
Next i
End Sub
Em lại có ví dụ sau để học mảng
- Sheet 1 có dữ liệu từ A1:C10
- Trong một hàng dữ liệu (ví dụ từ A1:C1) chỉ được nhận là trống hết, nếu đã điền, thì phải điền đủ dữ liệu
Ví dụ: - TH1: Điền hết dữ liệu
Cột A------Cột B----------Cột C
TM..... 09/03/2012--------201203 - TH2: để trống hết
Cột A------Cột B----------Cột C
..............................................
Yêu cầu
Dùng mảng để duyệt những dòng điền dữ liệu không đủ
Em có đoạn code sau như nó báo lỗi "Object required"
PHP:
Sub blank()
Dim sArr()
sArr = Sheet1.Range("A1:A10").Value
For i = 1 To UBound(sArr)
If WorksheetFunction.CountBlank(sArr(i, 1).Resize(, 3)) <> 3 Then
MsgBox "Sheet1 dong thu" & i & " chua dien du thong tin "
End If
Next i
End Sub
Đơn giản vì COUNTBLANK chỉ làm việc với Range, không làm việc với mảng đâu
Thêm nữa sArr(i, 1).Resize(, 3) là sai cú pháp ---> Mảng không cho phép Resize (chỉ dùng được Resize với Range mà thôi)
Sub blank()
Dim sArr()
sArr = Sheet1.Range("A1:C10").Value
For i = 1 To UBound(sArr, 1) ' 1 la chieu thu nhat de phan biet chieu thu 2
If sArr(i, 1) = "" And sArr(i, 2) = "" And sArr(i, 3) = "" Then
MsgBox "Sheet1 dong thu" & i & " chua dien du thong tin "
Exit Sub
End If
Next i
End Sub
Sub blank()
Dim sArr()
sArr = Sheet1.Range("A1:C10").Value
For i = 1 To UBound(sArr, 1) ' 1 la chieu thu nhat de phan biet chieu thu 2
If sArr(i, 1) = "" And sArr(i, 2) = "" And sArr(i, 3) = "" Then
MsgBox "Sheet1 dong thu" & i & " chua dien du thong tin "
Exit Sub
End If
Next i
End Sub
Sub loc()
Dim sArr(), Arr(), i As Long, j As Long
sArr = Sheet1.Range("A1:A100").Value
ReDim Arr(1 To UBound(sArr, 1), 1 To 1)
For i = 1 To UBound(sArr, 1)
If sArr(i, 1) > 0 Then
j = j + 1
Arr(j, 1) = sArr(i, 1)
Sheet1.[B1].Resize(j).Value = Arr
End If
Next
End Sub
và
PHP:
Sub loc()
Dim sArr(), Arr(), i As Long, j As Long
sArr = Sheet1.Range("A1:A100").Value
ReDim Arr(1 To UBound(sArr, 1), 1 To 1)
For i = 1 To UBound(sArr, 1)
If sArr(i, 1) > 0 Then
j = j + 1
Arr(j, 1) = sArr(i, 1)
End If
Next
Sheet1.[B1].Resize(j).Value = Arr
End Sub
Em xin hỏi nó có giống nhau hoàn toàn về mọi phương diện tính toán không?
Sub loc()
Dim sArr(), Arr(), i As Long, j As Long
sArr = Sheet1.Range("A1:A100").Value
ReDim Arr(1 To UBound(sArr, 1), 1 To 1)
For i = 1 To UBound(sArr, 1)
If sArr(i, 1) > 0 Then
j = j + 1
Arr(j, 1) = sArr(i, 1)
Sheet1.[B1].Resize(j).Value = Arr
End If
Next
End Sub
và
PHP:
Sub loc()
Dim sArr(), Arr(), i As Long, j As Long
sArr = Sheet1.Range("A1:A100").Value
ReDim Arr(1 To UBound(sArr, 1), 1 To 1)
For i = 1 To UBound(sArr, 1)
If sArr(i, 1) > 0 Then
j = j + 1
Arr(j, 1) = sArr(i, 1)
End If
Next
Sheet1.[B1].Resize(j).Value = Arr
End Sub
Em xin hỏi nó có giống nhau hoàn toàn về mọi phương diện tính toán không?
Kết quả giống nhau nhưng code thứ 2 sẽ nhanh hơn:
- Code thứ nhất, cứ lập 1 lần thì gán dữ liệu vào sheet
- Code thứ hai, làm xong vòng lập mới gán 1 lần vào sheet
------------
Hãy test với dữ liệu 10000 dòng trở lên để cảm nhận sự khác nhau về tốc độ 2 code nhé
Hai code trên giống nhau về việc xử lý dữ liệu nguồn cho ra dữ liệu kết quả (có tính toán gì đâu?)
Nhưng khác nhau ở trình tự gán xuống sheet.
Code 1: Mỗi vòng lặp thoả điều kiện sẽ gán xuống 1 lần, lần sau ghi đè lên lần trước, lần 1 chỉ có 1 ô có dữ liệu, còn toàn là gán ô trống, lần sau ít ô trống hơn, và lần cuối là dữ liệu kết quả đầy đủ nhất.
Code 2: Chỉ gán xuống sheet 1 lần khi kết quả đã đầy đủ.
Nhờ các pác giải thích dùm đoạn code trong bài tổng hợp số liệu
Em chưa hiểu được dòng lệnh With .Resize(.Rows.Count - 1, .Columns.Count - 1) trong Code
PHP:
Option Explicit
Private Sub Worksheet_Activate()
Dim Sh As Worksheet
Application.ScreenUpdating = False
Range("A2:C10000").ClearContents
For Each Sh In Worksheets
If Sh.Name <> "Tonghop" Then
With Sh.Range("A1").CurrentRegion.Offset(1, 1)
With .Resize(.Rows.Count - 1, .Columns.Count - 1)
Range("B65536").End(xlUp)(2).Resize(.Rows.Count, .Columns.Count).Value = .Value
End With
End With
End If
Next Sh
Range("A1").SpecialCells(4).Value = Evaluate("=Row(R1:R1000)")
Application.ScreenUpdating = True
End Sub
Resize nó giống như bạn dùng phím shift với các phím mũi tên lên xuống trái phải vậy đó bạn muốn kéo bao nhiêu cột, dòng thì nhấn phím lên xuống trái phải theo ý muốn, bạn tìm mấy bài của chú SA có nói kỹ về đó lắm Thuộc tính Resize của đối tượng Range trong VBA
Cám ơn bác nmhung49, về thuộc tính Resize thì em có biết nhưng em thắc mắc là tại sao nó mở rộng ra số dòng và số cột With .Resize(.Rows.Count - 1, .Columns.Count - 1) , tức là đoạn em bôi đen đấy ah.
Bởi em thấy dòng ngay trên nó
PHP:
With Sh.Range("A1").CurrentRegion.Offset(1, 1)
đã là toàn bộ vùng cần Copy sang rồi, sao còn mở rộng thêm làm gì nữa nhỉ?
Xin hỏi mảng Gom trong Code sau có ý nghĩa thế nào
Em xem ví dụ đính kèm mà vẫn chưa hiểu Mảng Gom nhằm để làm gì, xin được giải thích giúp
PHP:
Public Sub SapXep()
Dim Vung, I, Gom, Mg(), K, d
Set d = CreateObject("scripting.dictionary")
Vung = Range([A2], [A50000].End(xlUp)).Resize(, 3)
ReDim Mg(1 To UBound(Vung) * 3, 1 To 1)
For I = 1 To UBound(Vung)
Gom = Vung(I, 1) & Vung(I, 2)
If Not d.exists(Vung(I, 1)) And Not d.exists(Gom) Then
K = K + 1
d.Add Vung(I, 1), K
Mg(K, 1) = Vung(I, 1)
K = K + 1
d.Add Gom, K
Mg(K, 1) = Vung(I, 2)
K = K + 1
Mg(K, 1) = Vung(I, 3)
ElseIf d.exists(Vung(I, 1)) And Not d.exists(Gom) Then
K = K + 1
d.Add Gom, K
Mg(K, 1) = Vung(I, 2)
K = K + 1
Mg(K, 1) = Vung(I, 3)
Else
K = K + 1
Mg(K, 1) = Vung(I, 3)
End If
Next I
[F2:F10000].ClearContents
[F2].Resize(K) = Mg
End Sub
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
[SIZE=3][COLOR=#0000cd][B]Dim ArrKhoiLuong([/B][/COLOR][COLOR=#ff0000][B]n[/B][/COLOR][COLOR=#0000CD][B]) As String[/B][/COLOR][/SIZE]
For i = 0 To n
ArrKhoiLuong(i) = MyRng(i + 1).Value
Next
End Sub
Nếu như n = 3 và ghi là Dim ArrKhoiLuong(3) As String thì được, còn để vào n thì báo lỗi.
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
[SIZE=3][COLOR=#0000cd][B]Dim ArrKhoiLuong([/B][/COLOR][COLOR=#ff0000][B]n[/B][/COLOR][COLOR=#0000CD][B]) As String[/B][/COLOR][/SIZE]
For i = 0 To n
ArrKhoiLuong(i) = MyRng(i + 1).Value
Next
End Sub
Nếu như n = 3 và ghi là Dim ArrKhoiLuong(3) As String thì được, còn để vào n thì báo lỗi.
Trời!
Cái này nói nhiều lần rồi còn gì
Mảng không thể khai báo kiểu đó được! Muốn gì thì cứ Dim trước, xong sẽ ReDim (hoặc ReDim Preserve) sau đó theo biến
Ví dụ
Trời!
Cái này nói nhiều lần rồi còn gì
Mảng không thể khai báo kiểu đó được! Muốn gì thì cứ Dim trước, xong sẽ ReDim (hoặc ReDim Preserve) sau đó theo biến
Ví dụ
Cuối ngày rồi mình có 1 câu hỏi muốn hỏi các bạn ham thích về mảng Array cũng để các bạn hiểu rõ hơn về mảng Array
PHP:
Sub ArrinArr()
Dim Arr As Variant
Arr = Array(Array(Array(4, 5, 6), Array(7, 8, 9), Array(10, 11, 12)), Array(4, Array(13, 14, 15), 6))
'Debug.Print Arr(1)(1)(1)
End Sub
Bạn suy nghĩ trường hợp không dùng Option Base 1 thì truy xuất phần tử trong Array với kiểu truy xuất như dạng này Arr(1)(1)(1) thì giá trị là bao nhiêu, rồi dùng Option Base 1 thì giá trị là bao nhiêu suy nghĩ rồi thì bạn hãy dùng Debug.Print nhen! Các bạn cứ phát triển thêm phần tử trong mảng để hiểu rõ hơn
Nhưng anh Ndu đã giải thích có chỗ này bị lỗi anh Ndu sửa lại dùng em chỗ Arr(1)(1)(0) = 15 thành Arr(1)(1)(2) = 15 nhen. Còn dùng Option Base 1 thì sẽ khác rồi bạn cứ nghiên cứu từ từ nhen
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
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
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
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.
PHP:
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.
PHP:
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!
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.
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
Hàm JointStr có thể được cải tiến theo gợi ý của bạn như sau:
PHP:
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
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.
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
Hàm JointStr có thể được cải tiến theo gợi ý của bạn như sau:
PHP:
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
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
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)
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!):
PHP:
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
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)
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!
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
PHP:
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
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
PHP:
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ừ 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ị
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ụ:
Mã:
Sub Test()
Dim Arr
Arr = Array("A", "B", "C")
With Range("A1").Validation
.Delete
.Add 3, , , Join(Arr, ",")
End With
End Sub
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ụ:
Mã:
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
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
PHP:
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
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
PHP:
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 NDU
Ngày có định dạng như sau
yyyy/mm/dd hh:mm
PHP:
Sub testdate()
' text to column -> get date
Columns("B:B").Select
Selection.TextToColumns Destination:=Range("B1"), DataType:=xlFixedWidth, _
FieldInfo:=Array(Array(0, 4), Array(10, 1)), TrailingMinusNumbers:=True
End Sub
Tạm thời Tôi record mảrco, dùng Text Column ra rồi, nhưng chửa hiểu số 4 và số 10 trong Array có nghĩa gì?
Thanks
Cám ơn NDU
Ngày có định dạng như sau
yyyy/mm/dd hh:mm
PHP:
Sub testdate()
' text to column -> get date
Columns("B:B").Select
Selection.TextToColumns Destination:=Range("B1"), DataType:=xlFixedWidth, _
FieldInfo:=Array(Array(0, 4), Array(10, 1)), TrailingMinusNumbers:=True
End Sub
Tạm thời Tôi record mảrco, dùng Text Column ra rồi, nhưng chửa hiểu số 4 và số 10 trong Array có nghĩa gì?
Thanks
Định dạng yyyy/mm/dd là quá ngon rồi còn gì. Với định dạng này, bạn chỉ cần copy 1 ô trống, xong, paste special\Value + Add vào dữ liệu là ra ngay kết quả
Định dạng yyyy/mm/dd là quá ngon rồi còn gì. Với định dạng này, bạn chỉ cần copy 1 ô trống, xong, paste special\Value + Add vào dữ liệu là ra ngay kết quả
Các Bác chỉ giúp Code dưới này sai ở đâu? (tôi muốn thử làm với mảng nhưng chưa quen)
Tks
PHP:
Function SumAll(RngCur As Range, dk1, RngDate As Range, dk2, RngMethod As Range, dk3) As Long '
Dim i As Long
Dim ArrCur
Dim ArrDate
Dim ArrMethod
ArrCur = RngCur.Value
ArrDate = RngDate.Value
ArrMethod = RngMethod.Value
ArrAmt = RngCur.Offset(, 3).Value
For i = 1 To UBound(ArrCur())
If UCase$(ArrCur(i, 1)) = dk1 And _
UCase$(ArrDate(i, 1)) = dk2 And _
UCase$(ArrMethod(i, 1)) = dk3 Then
SumAll = SumAll + ArrAmt(i, 1)
End If
Next
End Function
Các Bác chỉ giúp Code dưới này sai ở đâu? (tôi muốn thử làm với mảng nhưng chưa quen)
Tks
PHP:
Function SumAll(RngCur As Range, dk1, RngDate As Range, dk2, RngMethod As Range, dk3) As Long '
Dim i As Long
Dim ArrCur
Dim ArrDate
Dim ArrMethod
ArrCur = RngCur.Value
ArrDate = RngDate.Value
ArrMethod = RngMethod.Value
ArrAmt = RngCur.Offset(, 3).Value
For i = 1 To UBound(ArrCur())
If UCase$(ArrCur(i, 1)) = dk1 And _
UCase$(ArrDate(i, 1)) = dk2 And _
UCase$(ArrMethod(i, 1)) = dk3 Then
SumAll = SumAll + ArrAmt(i, 1)
End If
Next
End Function
Làm được hay không ta chưa nói đến, chỉ xét bài này thì thấy nó tương đương với công thức =SUMPRODUCT(($A$2:$A$7=$G$1)*($B$2:$B$7=$F3)*($C$2:$C$7=G$2)*($D$2:$D$7))
Vậy nên dù bạn viết thế nào thì tốc độ tính toán của nó cũng sẽ không hơn SUMPRODUCT đâu
Đang thắc mắc: Tại sao bạn không dùng PivotTable để tổng hợp?
Làm được hay không ta chưa nói đến, chỉ xét bài này thì thấy nó tương đương với công thức =SUMPRODUCT(($A$2:$A$7=$G$1)*($B$2:$B$7=$F3)*($C$2:$C$7=G$2)*($D$2:$D$7))
Vậy nên dù bạn viết thế nào thì tốc độ tính toán của nó cũng sẽ không hơn SUMPRODUCT đâu
Đang thắc mắc: Tại sao bạn không dùng PivotTable để tổng hợp?
Cám ơn bác NDU
1. Tôi đang học mảng và thử trên nội dung này, (thấy Bác có hàm diengiai hay quá, định lò mò làm theo)
2. Lý do thứ 2 là Sumproduct, tôi thấy đưa vào VBA hơi khó. Đang cố thử làm lại (theo gợi ý của Bác )
3. PIVOT 2007 dữ liệu tổng hợp từ 2 sheet, tôi đã dùng multiple range (ALT + D + P) nhưng vẫn chưa thể làm ra được theo 3 điều kiện, đặc biệt điều kiện Date là từ một khoảng đến 1 khoảng
3. PIVOT 2007 dữ liệu tổng hợp từ 2 sheet, tôi đã dùng multiple range (ALT + D + P) nhưng vẫn chưa thể làm ra được theo 3 điều kiện, đặc biệt điều kiện Date là từ một khoảng đến 1 khoảng
PivotTable tôi không rành lắm, nhưng tôi nghĩ rằng: Nếu dùng multiple range không được thì sao ta không gộp 2 sheet lại thành một, xong dùng PivotTable chỉ là chuyện nhỏ
PivotTable tôi không rành lắm, nhưng tôi nghĩ rằng: Nếu dùng multiple range không được thì sao ta không gộp 2 sheet lại thành một, xong dùng PivotTable chỉ là chuyện nhỏ
Mong các anh chị giúp đở em, em có viết một cái hàm nội suy 1 chiều nhưng giờ em mở lên chạy thì lại bị vô hiệu hoá không chạy được, Mong các bác giúp em sơm để còn kip làm đồ án!
ReDim Arr(1 To UBound(SArr[COLOR=#ff0000]()[/COLOR]), 1 To 1)
For i = 1 To UBound(SArr[COLOR=#ff0000]()[/COLOR], 1)
Thành
Mã:
ReDim Arr(1 To UBound(SArr), 1 To 1)
For i = 1 To UBound(SArr, 1)
Còn tôi thì sẽ viết thế này:
Mã:
Sub ghep()
Dim Arr, i As Long
With Range([A3], [J65000].End(xlUp))
Arr = .Value
For i = 1 To UBound(Arr, 1)
Arr(i, 1) = Arr(i, 9) & Arr(i, 3) & Arr(i, 4)
Next i
.Resize(, 1).Value = Arr
End With
End Sub
ReDim Arr(1 To UBound(SArr[COLOR=#ff0000]()[/COLOR]), 1 To 1)
For i = 1 To UBound(SArr[COLOR=#ff0000]()[/COLOR], 1)
Thành
Mã:
ReDim Arr(1 To UBound(SArr), 1 To 1)
For i = 1 To UBound(SArr, 1)
Còn tôi thì sẽ viết thế này:
Mã:
Sub ghep()
Dim Arr, i As Long
With Range([A3], [J65000].End(xlUp))
Arr = .Value
For i = 1 To UBound(Arr, 1)
Arr(i, 1) = Arr(i, 9) & Arr(i, 3) & Arr(i, 4)
Next i
.Resize(, 1).Value = Arr
End With
End Sub
-----------------------------------------
Cái này được à nghen ---> Khỏi Dim cũng ReDim được đấy
Function diengiai(FVal, FindRng As Range, RestRng As Range) As String
Dim i As Long, j As Long, Temp, Arr(), Dic1, Dic2
Set Dic1 = CreateObject("Scripting.Dictionary")
Set Dic2 = CreateObject("Scripting.Dictionary")
For i = 1 To FindRng.Rows.Count
If FindRng(i, 1) = FVal Then ' neu thoa man
Temp = RestRng(i, 1) ' gan gia tri tu RestRng vao Temp
If Not Dic1.Exists(Temp) Then ' neu gia tri temp la duy nhat
j = j + 1
Dic1.Add Temp, 1 ' Dong nay nen dich hieu nhu nao? co phai add Item dau tien vao Temp
Dic2.Add Temp, j '??? add item thu J vao Temp
Else
Dic1.Item(Temp) = Dic1.Item(Temp) + 1 ' bo qua mot item neu ton tai???
End If
ReDim Preserve Arr(1 To j)
Arr(Dic2.Item(Temp)) = Temp '& "(" & Dic1.Item(Temp) & ")"
End If
Next
diengiai = Join(Arr, ", ")
End Function
Nhờ Các Bác giúp đỡ giải thích, chỉ dạy cho tôi một số dòng code, câu hỏi còn thắc mắc chưa hiểu
PHP:
1 Dic1.Add Temp, 1
2 Dic2.Add Temp, j
Dòng code 1: có phải add item đầu tiên vào key Temp ?
Dỏng code 2: có phải add item thứ j vào Key Temp?
Nếu vậy? tại sao dòng 2 mình không khai là
PHP:
1 Dic1.Add Temp, 1
2 Dic1.Add Temp, j
đoạn code dưới này có phải là bỏ qua một item trong RestRng (nếu đã có)
PHP:
Else
Dic1.Item(Temp) = Dic1.Item(Temp) + 1
Và tại sao mình lại phải ReDim Preserve Arr(1 To j)
Trong khi từ đầu mình chưa dùng gì đến Arr ???
Ngồi nghĩ cả buổi chiều mà ko hiểu thuât toán như nào? Các bác giúp tôi nhé
Em có bài toán đơn giản về mảng như thế này :
Tìm kiếm giá trị mà thỏa điều kiện đề ra thì ta táng vào 1 mảng. Và đọan code em viết như thế này : (ví dụ kèm theo )
Tuy nhiên cảm thấy chỉ có mỗi việc như thế mà chế đến đọan code dài dòng văn tự như thế này thì lãng phí quá.
Các cụ có cái thủ thuật nào hay và ngắn gọn, hoặc cái hàm nào ngắn gọn có thể trả về kết quả tương tự xin chỉ bảo hộ cho em với ...Em xin chân thành cám ơn các cụ ạ...!
Sub tt()
Dim i, k, count As Integer
Dim mang()
count = 0
i = 1
Do Until Cells(i, 1) = "END"
If Cells(i, 1) <> "" Then
count = count + 1
End If
i = i + 1
Loop
ReDim mang(1 To count, 2)
i = 1
k = 1
Do Until Cells(i, 1) = "END"
If Cells(i, 1) <> "" Then
mang(k, 1) = k
mang(k, 2) = Cells(i, 1)
k = k + 1
Else
k = k
End If
i = i + 1
Loop
For k = 1 To UBound(mang)
Cells(k + 2, 4) = mang(k, 1)
Cells(k + 2, 5) = mang(k, 2)
Next
End Sub
Em có bài toán đơn giản về mảng như thế này :
Tìm kiếm giá trị mà thỏa điều kiện đề ra thì ta táng vào 1 mảng. Và đọan code em viết như thế này : (ví dụ kèm theo )
Tuy nhiên cảm thấy chỉ có mỗi việc như thế mà chế đến đọan code dài dòng văn tự như thế này thì lãng phí quá.
Các cụ có cái thủ thuật nào hay và ngắn gọn, hoặc cái hàm nào ngắn gọn có thể trả về kết quả tương tự xin chỉ bảo hộ cho em với ...Em xin chân thành cám ơn các cụ ạ...!
Sub tt()
Dim i, k, count As Integer
Dim mang()
count = 0
i = 1
Do Until Cells(i, 1) = "END"
If Cells(i, 1) <> "" Then
count = count + 1
End If
i = i + 1
Loop
ReDim mang(1 To count, 2)
i = 1
k = 1
Do Until Cells(i, 1) = "END"
If Cells(i, 1) <> "" Then
mang(k, 1) = k
mang(k, 2) = Cells(i, 1)
k = k + 1
Else
k = k
End If
i = i + 1
Loop
For k = 1 To UBound(mang)
Cells(k + 2, 4) = mang(k, 1)
Cells(k + 2, 5) = mang(k, 2)
Next
End Sub
Mảng mà chạy trực tiếp trên Cell thì cũng bằng không! Cái này là "mảng nửa vời"
Tôi thì làm vầy:
Mã:
Sub Test()
Dim aSrc, Arr(), tmp As String
Dim i As Long, n As Long
aSrc = Range(Cells(1, 1), Cells(10000, 1)).Value
ReDim Arr(1 To UBound(aSrc, 1), 1 To 2)
For i = 1 To UBound(aSrc, 1)
tmp = CStr(aSrc(i, 1))
If tmp = "END" Then GoTo Finish
If Len(tmp) Then
n = n + 1
Arr(n, 1) = n
Arr(n, 2) = tmp
End If
Next
Finish:
If n Then Cells(3, 4).Resize(n, 2).Value = Arr
End Sub
Cám ơn thầy ndu nhé..biết ngay kiểu gì cũng có sự chỉ dẫn của thấy.. Ngắn gọn súc tích hơn , pờ rồ hơn nhưng nhiều cái phải tìm hiểu thêm...tìm hiểu kỹ thì mới nhớ lâu được..
Dùng máy công ty nó cổ lỗ sĩ quá, phần Help nó ít quá chả tham khảo được hàm nào cả...Em sẽ nghiên cứu thêm, mà không hiểu cái hàm Cstr của thầy nó có công dụng gì nhỉ ?
PS..Em đang săn cái thằng đối diện..để lồng vào cái Avatar của thầy, khi nào tìm được thằng ưng ý, em gửi cho thầy nhá....hè hè
Hàm CStr ấy mà ---> Biến mọi thứ thành kiểu dữ liệu String thôi
Trong code của bạn, nếu không có CStr cũng không sao, tại tôi quen tay rồi (nhằm tăng tốc)
Thực ra thấy cái Avatar của thầy giống như đang...chuẩn bị đánh ai thì phải...đoán như thế nên kiếm cái thằng đối diện cái avatar đó thêm vào cho đủ bộ ..ấy mà...
...
Tuy nhiên cảm thấy chỉ có mỗi việc như thế mà chế đến đọan code dài dòng văn tự như thế này thì lãng phí quá.
Các cụ có cái thủ thuật nào hay và ngắn gọn, hoặc cái hàm nào ngắn gọn có thể trả về kết quả tương tự xin chỉ bảo hộ cho em với ...
Mục đích lập trình của bạn là gì?
Từ "lãng phí" ở trên muốn nói về lãng phí loại tài nguyên (resource) nào? bộ nhớ trong khi chạy code, thời gian chiếm hữu CPU/ổ cứng, thời gian chạy code, công sức viết code, hay số bytes cần thiết để trữ code (tức là số dòng code)?
Bạn phải xác định mục đích "tránh lãng phí" của mình rồi mới nói chuyện chỉnh sửa code cho hiệu quả được.
Ví dụ với những array lớn thì dùng array càng nhiều càng tốn bộ nhớ.
Nếu chỉ tự nhận thấy code của mình luộm thuộm thì nên hỏi người ta xem luộm thuộm chỗ nào và có thể sửa được ra sao.
Code của bạn gồm có 3 phần:
1. đếm trong vùng dữ liệu xem có bao nhiêu dòng và lập mảng với độ lớn ấy
2. ghi nhưng dòng dữ liệu không trống vào mảng
3. ghi mảng vào vùng kết quả
Cái lãng phí của code này là:
- mỗi công việc trên lại phải dùng một vòng lặp, trong khi chỉ cần một vòng lặp là làm được hết rồi.
- mảng 2 chiều, nhưng cột thứ nhất chỉ là số thứ tự từ 1 đến n, thế thì có thể hiểu ngầm chứ chứa làm quái gì?
Lưu ý: những lời tôi nói trên dùng để chỉ dẫn cách cải tiến trình độ lập trình. Nếu chỉ muốn giải uyết vấn đề của đề bài một cách gọn đẹp thì code sủa ndu96081531 là có thể coi như tối ưu rồi.
Mục đích lập trình của bạn là gì?
Từ "lãng phí" ở trên muốn nói về lãng phí loại tài nguyên (resource) nào? bộ nhớ trong khi chạy code, thời gian chiếm hữu CPU/ổ cứng, thời gian chạy code, công sức viết code, hay số bytes cần thiết để trữ code (tức là số dòng code)?
Bạn phải xác định mục đích "tránh lãng phí" của mình rồi mới nói chuyện chỉnh sửa code cho hiệu quả được.
Ví dụ với những array lớn thì dùng array càng nhiều càng tốn bộ nhớ.
Nếu chỉ tự nhận thấy code của mình luộm thuộm thì nên hỏi người ta xem luộm thuộm chỗ nào và có thể sửa được ra sao.
Code của bạn gồm có 3 phần:
1. đếm trong vùng dữ liệu xem có bao nhiêu dòng và lập mảng với độ lớn ấy
2. ghi nhưng dòng dữ liệu không trống vào mảng
3. ghi mảng vào vùng kết quả
Cái lãng phí của code này là:
- mỗi công việc trên lại phải dùng một vòng lặp, trong khi chỉ cần một vòng lặp là làm được hết rồi.
- mảng 2 chiều, nhưng cột thứ nhất chỉ là số thứ tự từ 1 đến n, thế thì có thể hiểu ngầm chứ chứa làm quái gì?
Lưu ý: những lời tôi nói trên dùng để chỉ dẫn cách cải tiến trình độ lập trình. Nếu chỉ muốn giải uyết vấn đề của đề bài một cách gọn đẹp thì code sủa ndu96081531 là có thể coi như tối ưu rồi.
Thực sự là em là dân làm việc văn phòng, chưa qua trường lớp nào về lập trình cả. Toàn tự mày mò mà đọc rồi ứng dụng vào trong công việc thôi. Vì khi làm như thế này, em vẫn thấy cái code nó có đến 2 cái vòng lặp nên mới thấy mình ngu ngu nên mới mạo muội hỏi các thầy xem có cách khác hay không mà còn học hỏi thêm.
Ứng dụng thực sự là mảng 1 chiều thôi, làm cái 2 chiều để cho cái ví dụ cho các thầy dễ hiểu mà trả lời chính xác nội dung em cần hỏi thôi.
Những người mới học, mục đích của họ là: LÀM SAO TIẾP CẬN ĐƯỢC GIẢI THUẬT
Không bàn chuyện code đúng hay sai, hay hay dở... chỉ riêng chuyện code dài dòng cũng đủ gây khó khăn cho họ rồi (mù mù mờ mờ chẳng biết đâu mà lần)
Chỉ thế thôi
Mục đích lập trình của bạn là gì?
Từ "lãng phí" ở trên muốn nói về lãng phí loại tài nguyên (resource) nào? bộ nhớ trong khi chạy code, thời gian chiếm hữu CPU/ổ cứng, thời gian chạy code, công sức viết code, hay số bytes cần thiết để trữ code (tức là số dòng code)?
Bạn phải xác định mục đích "tránh lãng phí" của mình rồi mới nói chuyện chỉnh sửa code cho hiệu quả được.
Ví dụ với những array lớn thì dùng array càng nhiều càng tốn bộ nhớ.
Nếu chỉ tự nhận thấy code của mình luộm thuộm thì nên hỏi người ta xem luộm thuộm chỗ nào và có thể sửa được ra sao.
Code của bạn gồm có 3 phần:
1. đếm trong vùng dữ liệu xem có bao nhiêu dòng và lập mảng với độ lớn ấy
2. ghi nhưng dòng dữ liệu không trống vào mảng
3. ghi mảng vào vùng kết quả
Cái lãng phí của code này là:
- mỗi công việc trên lại phải dùng một vòng lặp, trong khi chỉ cần một vòng lặp là làm được hết rồi.
- mảng 2 chiều, nhưng cột thứ nhất chỉ là số thứ tự từ 1 đến n, thế thì có thể hiểu ngầm chứ chứa làm quái gì?
Lưu ý: những lời tôi nói trên dùng để chỉ dẫn cách cải tiến trình độ lập trình. Nếu chỉ muốn giải uyết vấn đề của đề bài một cách gọn đẹp thì code sủa ndu96081531 là có thể coi như tối ưu rồi.
Thầy bảo : - mỗi công việc trên lại phải dùng một vòng lặp, trong khi chỉ cần một vòng lặp là làm được hết rồi.
-> Nếu mà dùng theo cách của em như ban đầu, chỉ mỗi một vòng lặp thì làm thế nào thầy có thể khai báo được chính xác thành phần của mảng hả thầy ?
Thực ra cách giải giản dị (giản dị chứ không phải nhanh) nhất chả cần phải dùng mảng. Cứ đọc đến đâu ghi đến đấy.
Nếu bắt buộc phải dùng mảng thì dùng kỹ thuật chặp thêm mảng, ví dụ đặt mỗi khúc chặp thêm là 100 phần tử:
- Đặt một constant CHUNK = 100
- Đặt một biến đếm số phần tử n và một biến đếm cỡ mảng nmx
- Khởi mảng với CHUNK phần tử
- Khởi n=1, nmx = 100
- cứ mỗi lần truớc khi tăng n (+1) thì xét xem n đã đạt tới nmx chưa. Nếu đã đạt thì Redim Preserve mảng thêm CHUNK phần tử nữa.
Cuối cùng, ta được một mảng có thể dài hơn số phần tử nhưng chẳng sao cả, vì ta có số phần tử thật là n rồi.
Thầy bảo : - mỗi công việc trên lại phải dùng một vòng lặp, trong khi chỉ cần một vòng lặp là làm được hết rồi.
-> Nếu mà dùng theo cách của em như ban đầu, chỉ mỗi một vòng lặp thì làm thế nào thầy có thể khai báo được chính xác thành phần của mảng hả thầy ?
Nếu mảng rồi thì xài mảng luôn khỏi phải duyệt từng cell.
Thử cái "Cùi bắp" này xem kết quả có giống của bạn không.
PHP:
Public Sub CuiBap()
Dim sArr(), dArr(), I As Long, K As Long
sArr = Range([A1], [A65000].End(xlUp)).Value
ReDim dArr(1 To UBound(sArr, 1), 1 To 2)
For I = 1 To UBound(sArr, 1)
If sArr(I, 1) <> "" And sArr(I, 1) <> "END" Then
K = K + 1
dArr(K, 1) = K
dArr(K, 2) = sArr(I, 1)
End If
Next
[D3].Resize(K, 2).Value = dArr
End Sub
em có 1 câu hỏi như thế này:
ta có 1 file có 3 sheet :
sheet1 chưa mảng arr1
sheet2 chứa mảng arr2
sheet3 chứa mảng arr3
3 mảng trên đều cùng chiều ngang, nhưng chiều dài khác nhau
Bây giờ e muốn nối 3 mảng đó thành 1 mảng arr thôi ( mảng arr này là mảng tạm )Mục đích của e là chỉ dùng 1 vòng lập trên 1 mảng tổng arr này .
E có gửi file đính kèm, mong các a chị và các thầy hướng dẫn em ah !
em có 1 câu hỏi như thế này:
ta có 1 file có 3 sheet :
sheet1 chưa mảng arr1
sheet2 chứa mảng arr2
sheet3 chứa mảng arr3
3 mảng trên đều cùng chiều ngang, nhưng chiều dài khác nhau
Bây giờ e muốn nối 3 mảng đó thành 1 mảng arr thôi ( mảng arr này là mảng tạm )Mục đích của e là chỉ dùng 1 vòng lập trên 1 mảng tổng arr này .
E có gửi file đính kèm, mong các a chị và các thầy hướng dẫn em ah !
- Nếu chỉ đáp ứng vừa đủ nhu cầu của bạn (nối 3 mảng thành 1) thì đây là bài toán dễ
- Nếu viết ở mức tổng quát (nối bao nhiêu mảng 2 chiều tùy ý) thì cũng hơi.. khó 1 chút
Tôi thử xem:
Mã:
Function Join2DArray(ParamArray arrays())
Dim arr(), aSub, tmp
Dim lRs As Long, lCs As Long, lR As Long, lC As Long
Dim n As Long, m As Long, i As Long, bChk As Boolean
On Error Resume Next
For i = 0 To UBound(arrays)
aSub = arrays(i)
n = UBound(aSub, 1) - LBound(aSub, 1) + 1
lRs = lRs + n
m = UBound(aSub, 2) - LBound(aSub, 2) + 1
If lCs < m Then lCs = m
Next
ReDim arr(1 To lCs, 1 To lRs)
n = 0: m = 0
For i = 0 To UBound(arrays)
aSub = arrays(i)
For lR = LBound(aSub, 1) To UBound(aSub, 1)
bChk = False
n = n + 1
For lC = LBound(aSub, 2) To UBound(aSub, 2)
tmp = aSub(lR, lC)
Select Case VarType(tmp)
Case 0 To 1: arr(lC, n) = vbNullString
Case 2 To 7: arr(lC, n) = tmp
Case 8
If IsNumeric(tmp) Then
arr(lC, n) = "'" & tmp
Else
arr(lC, n) = tmp
End If
End Select
If Len(CStr(tmp)) Then bChk = True
Next
If bChk = False Then n = n - 1
Next
Next
If n Then
ReDim Preserve arr(1 To lCs, 1 To n)
Join2DArray = Transpose2DArray(arr)
End If
End Function
Mã:
Function Transpose2DArray(ByVal arr2D)
Dim arr(), aTemp
Dim lR As Long, lC As Long
On Error Resume Next
aTemp = arr2D
ReDim arr(LBound(aTemp, 2) To UBound(aTemp, 2), LBound(aTemp, 1) To UBound(aTemp, 1))
For lR = LBound(aTemp, 1) To UBound(aTemp, 1)
For lC = LBound(aTemp, 2) To UBound(aTemp, 2)
arr(lC, lR) = aTemp(lR, lC)
Next
Next
Transpose2DArray = arr
End Function
Giờ đến phần ứng dụng ta viết thế này:
Mã:
Sub Main()
Dim [COLOR=#ff0000][B]aRes[/B][/COLOR]
[COLOR=#ff0000][B]aRes[/B][/COLOR] = Join2DArray(Sheet1.Range("D4:O1000"), Sheet2.Range("D4:O1000"), Sheet3.Range("D4:O1000"))
End Sub
aRes chính mà mảng tạm mà bạn cần. Ví dụ có thể gán mảng tạm aRes xuống sheet như thế này:
Mã:
Sub Main()
Dim aRes
aRes = Join2DArray(Sheet1.Range("D4:O1000"), Sheet2.Range("D4:O1000"), Sheet3.Range("D4:O1000"))
Sheet4.Range("D4").Resize(UBound(aRes, 1), UBound(aRes, 2)).Value = aRes
End Sub
Em cám ơn thầy, code chạy ok . nhưng xin thầy vui lòng giải thích giùm e đoạn code này được không ah ! nhất là hàm vartype
PHP:
Select Case VarType(tmp)
Case 0 To 1: arr(lC, n) = vbNullString
Case 2 To 7: arr(lC, n) = tmp
Case 8
If IsNumeric(tmp) Then
arr(lC, n) = "'" & tmp
Else
arr(lC, n) = tmp
End If
End Select
Em cám ơn thầy, code chạy ok . nhưng xin thầy vui lòng giải thích giùm e đoạn code này được không ah ! nhất là hàm vartype
PHP:
Select Case VarType(tmp)
Case 0 To 1: arr(lC, n) = vbNullString
Case 2 To 7: arr(lC, n) = tmp
Case 8
If IsNumeric(tmp) Then
arr(lC, n) = "'" & tmp
Else
arr(lC, n) = tmp
End If
End Select
VarType để kiểm tra dữ liệu của bạn thuộc dạng Text hay là Number
Syntax||
VarType(varname)
||
The required varname argument is a Variant containing any variable except a variable of a user-defined type.||
Return Values||
Constant|Value|Description
vbEmpty|0|Empty (uninitialized)
vbNull|1|Null (no valid data)
vbInteger|2|Integer
vbLong|3|Long integer
vbSingle|4|Single-precision floating-point number
vbDouble|5|Double-precision floating-point number
vbCurrency|6|Currency value
vbDate|7|Date value
vbString|8|String
vbObject|9|Object
vbError|10|Error value
vbBoolean|11|Boolean value
vbVariant|12|Variant (used only with arrays of variants)
vbDataObject|13|A data access object
vbDecimal|14|Decimal value
vbByte|17|Byte value
vbLongLong|20|LongLong integer (Valid on 64-bit platforms only.)
vbUserDefinedType|36|Variants that contain user-defined types
vbArray|8192|Array
Tôi phân các trường hợp trong Select Case để phòng trường hợp dữ liệu dạng Text nhưng chứa number, ví dụ là 0331... Trường hợp này nếu không có đoạn Select Case như trên thì chắc chắn kết quả nhận được sẽ là 331 (mất số 0 ở đầu)
------------
Ví dụ thêm trường hợp cột dữ liệu của bạn chứa số điện thoại chẳng hạn, sẽ luôn có số 0 ở đầu. Vậy phải bảo đảm kết quả xuất ra cũng y chang vậy (có số 0 ở đầu)
Các thầy ơi cho em hỏi :
Trong VBA có cái hàm nào dùng để so sánh 2 mảng đồng cấp không hả các thầy ? Hay bắt buộc mình phải tự sướng mà chế code ?
Ví dụ :
Em có cái mảng EX1(1 to 3, 2) làm chuẩn.
Mảng EX2(1 To 3)
Lấy EX2 vác đi so sánh với từng trị trong mảng EX1, nếu trùng nhau hoàn toàn thì OK, không thì NG
Chằng hạn EX1(1 to 3,1 ) = {A,B,C}
EX1 (1 to 3,2) = {D,E,F}
EX2(1 to 3) = { D,E,F}
-> EX1(1 to 3, 1) trả về NG
EX1(1 to 3, 2) trả về OK
Các thầy ơi cho em hỏi :
Trong VBA có cái hàm nào dùng để so sánh 2 mảng đồng cấp không hả các thầy ? Hay bắt buộc mình phải tự sướng mà chế code ?
Ví dụ :
Em có cái mảng EX1(1 to 3, 2) làm chuẩn.
Mảng EX2(1 To 3)
Lấy EX2 vác đi so sánh với từng trị trong mảng EX1, nếu trùng nhau hoàn toàn thì OK, không thì NG
Chằng hạn EX1(1 to 3,1 ) = {A,B,C}
EX1 (1 to 3,2) = {D,E,F}
EX2(1 to 3) = { D,E,F}
-> EX1(1 to 3, 1) trả về NG
EX1(1 to 3, 2) trả về OK
Các thầy chỉ cho em giải bài tóan này với, em so sánh mãi mà không được. ( file đính kèm)
1-Ta lấy giá trị mảng ở Mảng so sánh.
2-Lấy giá trị mảng đa chiều bắt đầu từ hàng 2, cột 1
3-So sánh nếu chỉ cần 1 trị của mảng so sánh khác với vùng so sánh thì ta điền cả mảng vào cột kế tiếp
Em viết như code như thế này mà không hiểu nó sai chỗ nào mà nó chả có ý kiến gì
Sub MangKiemta()
Dim i, j, k, t, r As Integer
Dim Mang()
Dim MangA(1 To 14)
i = 1
Do Until IsEmpty(Cells(2, i))
j = j + 1
i = i + 1
Loop
ReDim Mang(1 To 14, j)
For k = 1 To j
For i = 1 To 14
Mang(i, k) = Cells(i + 1, k)
Next
Next
For t = 1 To UBound(MangA)
MangA(t) = Cells(19 + t, 1)
Next
For r = 1 To 14
For k = 1 To j
If MangA(r) <> Mang(r, k) Then
Cells(r + 1, j) = MangA(r)
End If
Next
Next
Các anh chị cho em hỏi, tìm trên google mãi mà không ra
Ý của em hỏi là làm sao giống như trong file đính kèm, hàm bdttct2ltcxdvn có 21 hàng và 2 cột, các giá trị của hàm này được gán cho ô B17 đến ô C37 mà chỉ sử dụng duy nhất lệnh =bdttct2ltcxdvn(B3,B4,B7,B8,B9,B5,B6,B10,B11,B12) cho tất cả các ô . Muốn làm như vậy thì phải làm sao, cách tạo 1 sub thì em cũng biết nhưng em muốn làm giống như trong file. Mong các anh chị giúp đỡ
Nhờ chỉnh dùm code xử lý mảng lấy từ mảng sẳn có
Mình có thắc mắc như thế này: mình lấy dử liệu từ ADO gán vào Array1 sau đó gán tiếp xuống Sheet Range, sau đó gán Array2 = Range để xử lý tạo ra Array3 gán xuống sheet kết quả thì đươc. Nhưng khi mình lấy trực tiếp từ Array1 để xử lý tạo ra Array3 thì không được. Xin mọi người chỉ giáo. Mình cám ơn rất nhiều. (Mình có ghi chú trong code.)
Cho em hỏi về copy có điều kiện một chút ah.
- thứ nhất em có một danh sách ở sheet2 gồm 5 cột (họ tên , mã số , tháng 1, tháng 2, tháng 3) nếu trong cột tháng 2, tháng 3 >0 thì lấy đươa vào sheet3 em dùng đoạn code nhứ sau
Sub copy()
On Error Resume Next
Dim vung(), Arr(), HC As Long
With Sheet2
HC = .Range("A65536").End(xlUp).Row
vung = .Range("A2:M" & HC).Value
ReDim Arr(1 To UBound(vung, 1), 1 To 13)
For i = 1 To UBound(vung, 1)
If vung(i, 4) > 0 Or vung(i, 5) > 0 Then
k = k + 1
For y = 1 To 13
Arr(k, y) = vung(i, y)
Next y
End If
Next i
Sheet3.Range("A2").Resize(k, 13).Value = Arr
End With
End Sub
đoạn code chạy được nhưng vấn đề là ở cột mã KH thì mã số KH lại biến thành số xin các Bro giải thich giúp e chỗ này với ah.
- Thứ hai là bây giờ em muốn chọn tiếp ở sheet1 cột tháng 2 nếu > 0 thì lấy sang sheet4, ở sheet2 nếu cột tháng 1 <0 thì lấy sang sheet4 thì đoạn code trên phải sửa lại như thế nào ah, em cũng mới học về mảng nên còn mơ hồ lắm ah @_@.
em gửi file VD đính kèm ở dưới
Cho em hỏi về copy có điều kiện một chút ah.
- thứ nhất em có một danh sách ở sheet2 gồm 5 cột (họ tên , mã số , tháng 1, tháng 2, tháng 3) nếu trong cột tháng 2, tháng 3 >0 thì lấy đươa vào sheet3 em dùng đoạn code nhứ sau
Sub copy()
On Error Resume Next
Dim vung(), Arr(), HC As Long
With Sheet2
HC = .Range("A65536").End(xlUp).Row
vung = .Range("A2:M" & HC).Value
ReDim Arr(1 To UBound(vung, 1), 1 To 13)
For i = 1 To UBound(vung, 1)
If vung(i, 4) > 0 Or vung(i, 5) > 0 Then
k = k + 1
For y = 1 To 13
Arr(k, y) = vung(i, y)
Next y
End If
Next i
Sheet3.Range("A2").Resize(k, 13).Value = Arr
End With
End Sub
đoạn code chạy được nhưng vấn đề là ở cột mã KH thì mã số KH lại biến thành số xin các Bro giải thich giúp e chỗ này với ah.
- Thứ hai là bây giờ em muốn chọn tiếp ở sheet1 cột tháng 2 nếu > 0 thì lấy sang sheet4, ở sheet2 nếu cột tháng 1 <0 thì lấy sang sheet4 thì đoạn code trên phải sửa lại như thế nào ah, em cũng mới học về mảng nên còn mơ hồ lắm ah @_@.
em gửi file VD đính kèm ở dưới
1/ Bạn format cột B sheet3 thành Text rồi chạy code lại thử xem.
2/ Đã lấy dữ liệu được 1 sheet thì lặp lại như vậy cho 1 sheet nữa rồi gán vào sheet 4, cách nào tùy bạn.
lấy dư lệu từng sheet thì em làm được rồi cách làm thế này, cũng đoạn code trên em lấy dữ liệu sheet2 cột tháng 1 xong đưa sang sheet4, sau đó sang sheet1 lấy dữ liệu và đưa sang sheet 4, em muốn là lấy dữ liệu sheet1, sheet 2 xong mói đưa dữ liệu sang sheet4 một lúc cơ
lấy dư lệu từng sheet thì em làm được rồi cách làm thế này, cũng đoạn code trên em lấy dữ liệu sheet2 cột tháng 1 xong đưa sang sheet4, sau đó sang sheet1 lấy dữ liệu và đưa sang sheet 4, em muốn là lấy dữ liệu sheet1, sheet 2 xong mói đưa dữ liệu sang sheet4 một lúc cơ
Mình có chút vấn đền nhỏ không biết như thế nào... làm mãi vẫn không đúng.
Vui lòng xem file đính kèm.
[GPECODE=VB]
Sub ShowResult_OR()
Dim rngCellData1, rngCellData2, rngList1, rngList2 As Range
Dim wksTemp As Worksheet
Dim iLastRow1, iLastRow2, iLastRowResult, i As Long
Dim Dic, arrResult_OR
Set wksTemp = Worksheets("Temp")
iLastRow1 = LastRow(wksTemp, 3)
iLastRow2 = LastRow(wksTemp, 5)
iLastRowResult = LastRow(wksTemp, 7)
wksTemp.Range("G4:G" & iLastRowResult).Select
Selection.Clear
wksTemp.Range("G4").Select
Set rngList1 = wksTemp.Range("C4:C" & iLastRow1)
Set rngList2 = wksTemp.Range("E4:E" & iLastRow2)
On Error Resume Next
Set Dic = CreateObject("Scripting.Dictionary")
For Each rngCellData1 In rngList1
If Not IsEmpty(rngCellData1) Then Dic.Add rngCellData1.Value, ""
Next rngCellData1
For Each rngCellData2 In rngList2
If Not IsEmpty(rngCellData2) Then Dic.Add rngCellData2.Value, ""
Next rngCellData2
nếu chạy đoạn code tô màu đỏ thì ra kết quả sai!!! wksTemp.Range("G4").Resize(UBound(arrResult_OR, 1) + 1, 1) = arrResult_OR --> kết quả sai
nếu chạy lại bẳng cách thay đoạn code màu đỏ bằng màu xanh thì ra kết quả đúng!!!!
For i = 0 To UBound(arrResult_OR, 1)
wksTemp.Range("G" & i + 4) = arrResult_OR(i)
Next i
[GPECODE=VB]
Sub ShowResult_OR()
Dim rngCellData1, rngCellData2, rngList1, rngList2 As Range
Dim wksTemp As Worksheet
Dim iLastRow1, iLastRow2, iLastRowResult, i As Long
Dim Dic, arrResult_OR
Set wksTemp = Worksheets("Temp")
iLastRow1 = LastRow(wksTemp, 3)
iLastRow2 = LastRow(wksTemp, 5)
iLastRowResult = LastRow(wksTemp, 7)
wksTemp.Range("G4:G" & iLastRowResult).Select
Selection.Clear
wksTemp.Range("G4").Select
Set rngList1 = wksTemp.Range("C4:C" & iLastRow1)
Set rngList2 = wksTemp.Range("E4:E" & iLastRow2)
On Error Resume Next
Set Dic = CreateObject("Scripting.Dictionary")
For Each rngCellData1 In rngList1
If Not IsEmpty(rngCellData1) Then Dic.Add rngCellData1.Value, ""
Next rngCellData1
For Each rngCellData2 In rngList2
If Not IsEmpty(rngCellData2) Then Dic.Add rngCellData2.Value, ""
Next rngCellData2
Dạ đúng rùi ah...
nhưng cái mục đích này chỉ là "cái cớ" để nghiên cứu DICTIONARY , và MẢNG mà thôi.
Hiện tại mình "kẹt" vấn đề "GÁN GIÁ TRỊ Dic.Keys VÀO MẢNG, Và GHI MẢNG NÀY LÊN SHEET.
VIỆC GHI CỦA MÌNH KHÔNG THÀNH CÔNG (Code màu đó). nếu ghi bằng lệnh FOR thì OK nhưng thời gian làm rất là lâu!!!
vậy bạn có thể giúp mình ghi mảng được gán từ Dic.Keys lên Sheet không ah...
Cám ơn bạn nhiều.
Dạ đúng rùi ah...
nhưng cái mục đích này chỉ là "cái cớ" để nghiên cứu DICTIONARY , và MẢNG mà thôi.
Hiện tại mình "kẹt" vấn đề "GÁN GIÁ TRỊ Dic.Keys VÀO MẢNG, Và GHI MẢNG NÀY LÊN SHEET.
VIỆC GHI CỦA MÌNH KHÔNG THÀNH CÔNG (Code màu đó). nếu ghi bằng lệnh FOR thì OK nhưng thời gian làm rất là lâu!!!
vậy bạn có thể giúp mình ghi mảng được gán từ Dic.Keys lên Sheet không ah...
Cám ơn bạn nhiều.
Sub OneColumnUniqueArrays(ByRef UniqueArray(), _
ByRef RowCount As Long, _
ParamArray ManiOneColumnArrays())
Dim SubArray, EachItem, Dict As Object
Set Dict = CreateObject("Scripting.Dictionary")
For Each SubArray In ManiOneColumnArrays
If Not IsArray(SubArray) Then SubArray = Array(SubArray)
For Each EachItem In SubArray
If Not IsEmpty(EachItem) And Not Dict.Exists(EachItem) Then
Dict.Add EachItem, ""
End If
Next
Next
If Dict.Count Then
UniqueArray = [COLOR=#ff0000][B]Application.WorksheetFunction.Transpose(Dict.Keys)[/B][/COLOR]
RowCount = Dict.Count
End If
Set Dict = Nothing
End Sub
Sub Test()
Dim UniqueArray(), RowCount As Long
With Sheets("Temp")
OneColumnUniqueArrays UniqueArray, RowCount, .Range("C4:C23"), .Range("E4:E25") 'Muon cot nao nua thi them vao
.Range("G3:G65536").ClearContents
.Range("G3") = RowCount & " pictures"
.Range("G4").Resize(RowCount) = UniqueArray
End With
End Sub
Bản thân Dict.Keys nó là mảng một chiều nên khi gán cho UniqueArray phải hoán vị cho nó.
Tức không muốn dùng Hàm Application.WorksheetFunction.Transpose (hàm của Excel)
thì bạn có thể sửa lại như sau:
Mã:
Sub OneColumnUniqueArrays(ByRef UniqueArray(), _
ByRef RowCount As Long, _
ParamArray ManiOneColumnArrays())
Dim SubArray, EachItem, Dict As Object
Set Dict = CreateObject("Scripting.Dictionary")
For Each SubArray In ManiOneColumnArrays
If Not IsArray(SubArray) Then SubArray = Array(SubArray)
For Each EachItem In SubArray
If Not IsEmpty(EachItem) And Not Dict.Exists(EachItem) Then
Dict.Add EachItem, ""
End If
Next
Next
[COLOR=#0000ff] RowCount = Dict.Count[/COLOR]
[COLOR=#0000ff] If RowCount Then[/COLOR]
[COLOR=#0000ff] Dim r As Long, DictKeys()[/COLOR]
[COLOR=#0000ff] DictKeys = Dict.Keys[/COLOR]
[COLOR=#0000ff] ReDim UniqueArray(1 To RowCount, 1 To 1)[/COLOR]
[COLOR=#0000ff] For r = 1 To RowCount[/COLOR]
[COLOR=#0000ff] UniqueArray(r, 1) = DictKeys(r - 1)[/COLOR]
[COLOR=#0000ff] Next[/COLOR]
[COLOR=#0000ff] End If
[/COLOR]
Set Dict = Nothing
End Sub
Những chỗ màu xanh là sửa lại.
Bạn cũng nên bẫy lỗi cho trường hợp không có mục nào được lọc (tức là mảng rỗng):
Mã:
Sub Test()
Dim UniqueArray(), RowCount As Long
With Sheets("Temp")
OneColumnUniqueArrays UniqueArray, RowCount, .Range("C4:C23"), .Range("E4:E25") 'Muon cot nao nua thi them vao
.Range("G3:G65536").ClearContents
[COLOR=#0000ff] If RowCount > 0 Then[/COLOR]
[COLOR=#0000ff] .Range("G3") = RowCount & " pictures"[/COLOR]
[COLOR=#0000ff] .Range("G4").Resize(RowCount) = UniqueArray[/COLOR]
[COLOR=#0000ff] End If[/COLOR]
End With
End Sub
Tức không muốn dùng Hàm Application.WorksheetFunction.Transpose (hàm của Excel)
thì bạn có thể sửa lại như sau:
Mã:
Sub OneColumnUniqueArrays(ByRef UniqueArray(), _
ByRef RowCount As Long, _
ParamArray ManiOneColumnArrays())
Dim SubArray, EachItem, Dict As Object
Set Dict = CreateObject("Scripting.Dictionary")
For Each SubArray In ManiOneColumnArrays
If Not IsArray(SubArray) Then SubArray = Array(SubArray)
For Each EachItem In SubArray
If Not IsEmpty(EachItem) And Not Dict.Exists(EachItem) Then
Dict.Add EachItem, ""
End If
Next
Next
[COLOR=#0000ff] RowCount = Dict.Count[/COLOR]
[COLOR=#0000ff] If RowCount Then[/COLOR]
[COLOR=#0000ff] Dim r As Long, DictKeys()[/COLOR]
[COLOR=#0000ff] DictKeys = Dict.Keys[/COLOR]
[COLOR=#0000ff] ReDim UniqueArray(1 To RowCount, 1 To 1)[/COLOR]
[COLOR=#0000ff] For r = 1 To RowCount[/COLOR]
[COLOR=#0000ff] UniqueArray(r, 1) = DictKeys(r - 1)[/COLOR]
[COLOR=#0000ff] Next[/COLOR]
[COLOR=#0000ff] End If
[/COLOR]
Set Dict = Nothing
End Sub
Những chỗ màu xanh là sửa lại.
Bạn cũng nên bẫy lỗi cho trường hợp không có mục nào được lọc (tức là mảng rỗng):
Mã:
Sub Test()
Dim UniqueArray(), RowCount As Long
With Sheets("Temp")
OneColumnUniqueArrays UniqueArray, RowCount, .Range("C4:C23"), .Range("E4:E25") 'Muon cot nao nua thi them vao
.Range("G3:G65536").ClearContents
[COLOR=#0000ff] If RowCount > 0 Then[/COLOR]
[COLOR=#0000ff] .Range("G3") = RowCount & " pictures"[/COLOR]
[COLOR=#0000ff] .Range("G4").Resize(RowCount) = UniqueArray[/COLOR]
[COLOR=#0000ff] End If[/COLOR]
End With
End Sub
dạ vấn đề là ở chỗ này đó , em mới biết về mảng nên còn mơ hồ lắm, đoạn code trên em làm được là dựa vào các bài trước mọi người thảo luận đó ah, tuy làm ra kết quả nhưng mà vẫn chưa hiểu rõ lắm cho nên em không biết làm thế nào để chỉ dùng 1 Arr() mà gán sheet1 vào rồi lại gán tiếp sheet2 vào @_@ xong rồi mới gán vào sheet4 cùng một lúc, nếu được Mong Bro chỉ cho em chi tiết hơn một chút nữa không ah.
dạ vấn đề là ở chỗ này đó , em mới biết về mảng nên còn mơ hồ lắm, đoạn code trên em làm được là dựa vào các bài trước mọi người thảo luận đó ah, tuy làm ra kết quả nhưng mà vẫn chưa hiểu rõ lắm cho nên em không biết làm thế nào để chỉ dùng 1 Arr() mà gán sheet1 vào rồi lại gán tiếp sheet2 vào @_@ xong rồi mới gán vào sheet4 cùng một lúc, nếu được Mong Bro chỉ cho em chi tiết hơn một chút nữa không ah.
Bạn chờ "Bro" đi.
Tui thì vừa già vừa dốt không biết "Bro" là cái gì. Nếu làm giúp bạn thì tui là "Bro" sao?
Híc. Tiếng Việt nhiều khi tui còn hổng hiểu.
Bạn chờ "Bro" đi.
Tui thì vừa già vừa dốt không biết "Bro" là cái gì. Nếu làm giúp bạn thì tui là "Bro" sao?
Híc. Tiếng Việt nhiều khi tui còn hổng hiểu.
ui trời cái tội sử dụng tiếng lóng sửa mãi không chừa em thành thật xin lỗi , lâu nay ra tiệm net toàn chơi game nên mới bị nhiễm mấy thứ ngôn ngữ này Mong các thầy trên diễn đàn chỉ bảo thêm ạ ! em xin chân thành cảm ơn !
Hi các a/c.
Giúp mình trường hợp sau:
có 1 mảng (range) là số có sắp xếp từ nhỏ tới lớn và không có giá trị trùng nhau, mình muốn dùng VBA để tìm giá trị trong mảng đó gần nhất với 1 giá trị cho trước (lớn hơn hoặc nhỏ hơn).
ví dụ mảng: 12,25,29,35,43,55,60
Giá trị cho trước: là 30 kết quả là 29, là 33 kết quả là 35.
Hi các a/c.
Giúp mình trường hợp sau:
có 1 mảng (range) là số có sắp xếp từ nhỏ tới lớn và không có giá trị trùng nhau, mình muốn dùng VBA để tìm giá trị trong mảng đó gần nhất với 1 giá trị cho trước (lớn hơn hoặc nhỏ hơn).
ví dụ mảng: 12,25,29,35,43,55,60
Giá trị cho trước: là 30 kết quả là 29, là 33 kết quả là 35.
Tham khảo code này. Tuy nhiên để xài được chắc phải sửa lại nhiều
PHP:
Sub test()
Dim Sarr(), Dk, I
Sarr = Array(12, 25, 39, 43, 55, 60, 76, 85)
Dk = 30
Do
If Sarr(I) > Dk Then
MsgBox "So lon hon là: " & Sarr(I)
If Sarr(I - 1) <> Dk Then
MsgBox "So nho hon là: " & Sarr(I - 1)
Else
MsgBox "So nho hon là: " & Sarr(I - 2)
End If
Exit Do
End If
I = I + 1
Loop Until I > UBound(Sarr)
End Sub
Hi các a/c.
Giúp mình trường hợp sau:
có 1 mảng (range) là số có sắp xếp từ nhỏ tới lớn và không có giá trị trùng nhau, mình muốn dùng VBA để tìm giá trị trong mảng đó gần nhất với 1 giá trị cho trước (lớn hơn hoặc nhỏ hơn).
ví dụ mảng: 12,25,29,35,43,55,60
Giá trị cho trước: là 30 kết quả là 29, là 33 kết quả là 35.
Đề bài dỏm. Nếu số nằm ngay giữa 2 phần tử của mảng thì chọn trị nào?
Thường thường tìm trong mảng có sắp xếp thì người ta dùng giải thuật tìm nhị phân (binary search), và dùng hàm đệ quy.
code sau đây giả định nếu nằm giữa 2 phần tử thì chọn phần tử trước
Mã:
Sub t()
Dim Sarr()
Sarr = Array(12, 25, 39, 43, 55, 60, 76, 85)
Debug.Print TriGanNhat(30, Sarr, LBound(Sarr), UBound(Sarr))
End Sub
Function TriGanNhat(ByVal tri As Integer, ByRef mang() As Variant, ByVal dau As Integer, ByVal duoi As Integer) As Integer
' hàm đệ quy tìm giá trị gần nhất trong một mảng
If dau + 1 >= duoi Then ' chỉ còn 2 điểm, như vậy 1 trong 2 phải là đáp số
If tri <= (mang(dau) + mang(duoi)) / 2 Then TriGanNhat = mang(dau) Else TriGanNhat = mang(duoi)
Exit Function
End If
Dim giua As Integer ' điểm giữa chia mảng thành 2 đoạn
giua = (dau + duoi) / 2
If tri = mang(giua) Then ' tìm được trị chính xác
TriGanNhat = mang(giua)
ElseIf tri > mang(giua) Then
TriGanNhat = TriGanNhat(tri, mang, giua, duoi) ' đáp số nằm ở đoạn 2, tiếp tục dò
Else
TriGanNhat = TriGanNhat(tri, mang, dau, giua) ' đáp số nằm ở đoạn 1, tiếp tục dò
End If
End Function
Đề bài dỏm. Nếu số nằm ngay giữa 2 phần tử của mảng thì chọn trị nào?
Thường thường tìm trong mảng có sắp xếp thì người ta dùng giải thuật tìm nhị phân (binary search), và dùng hàm đệ quy.
code sau đây giả định nếu nằm giữa 2 phần tử thì chọn phần tử trước
Mã:
Sub t()
Dim Sarr()
Sarr = Array(12, 25, 39, 43, 55, 60, 76, 85)
Debug.Print TriGanNhat(30, Sarr, LBound(Sarr), UBound(Sarr))
End Sub
Function TriGanNhat(ByVal tri As Integer, ByRef mang() As Variant, ByVal dau As Integer, ByVal duoi As Integer) As Integer
' hàm đệ quy tìm giá trị gần nhất trong một mảng
If dau + 1 >= duoi Then ' chỉ còn 2 điểm, như vậy 1 trong 2 phải là đáp số
If tri <= (mang(dau) + mang(duoi)) / 2 Then TriGanNhat = mang(dau) Else TriGanNhat = mang(duoi)
Exit Function
End If
Dim giua As Integer ' điểm giữa chia mảng thành 2 đoạn
[B][COLOR=#ff0000]giua = (dau + duoi) / 2[/COLOR][/B]
If tri = mang(giua) Then ' tìm được trị chính xác
TriGanNhat = mang(giua)
ElseIf tri > mang(giua) Then
TriGanNhat = TriGanNhat(tri, mang, giua, duoi) ' đáp số nằm ở đoạn 2, tiếp tục dò
Else
TriGanNhat = TriGanNhat(tri, mang, dau, giua) ' đáp số nằm ở đoạn 1, tiếp tục dò
End If
End Function
Cần nhớ là việc thực hiện code đơn giản vd. k = (a + b) / 2 là quá trình tính từng bước. Bộ vi xử lý hay việc tính toán trên giấy bằng tay cũng thế, không thể đồng thời thực hiện phép cộng và chia được.
Trước hết phép cộng (a + b) được thực hiện và kết quả đó được nhớ tạm "ở đâu đó". Sau đó mới thực hiện phép chia giá trị "ở đâu đó" cho 2 và trả về kết quả. Phải rất thận trọng vì dễ quên và kết quả trung gian sẽ vượt quá giới hạn.
Khi tính vd. (a + b) thì kết quả trung gian sẽ được gán cho kiểu có giới hạn rộng nhất trong a và b. Tức nếu a as Integer và b As Long thì kết quả trung gian sẽ được gán cho kiểu Long. Nhưng nếu cũng có b As Integer thì kết quả trung gian sẽ được gán cho kiểu Integer.
Ta xét code
Mã:
Dim k as integer, a as Integer, b as Integer
a = 16000
b = 32000
k = (a + b) / 2
Msgbox k
Rõ ràng giá trị k = 24000 nằm trong giới hạn của Integer. a và b cũng thế.
Nhưng Run code sẽ có lỗi tại dòng k = (a + b) / 2. Vì sao? Vì khi tính (a + b) thì kết quả trung gian này sẽ được gán cho kiểu Integer do a và b đều là kiểu Integer. Nhưng kết quả trung gian này lại có giá trị 48000, tức vượt quá giới hạn của kiểu Integer. Do vậy có lỗi Overflow
Phải rất chú ý vì nhiều khi mọi biến "tham gia" trong phép toán (ở trên là a và b) đều có giá trị không vượt quá giới hạn của kiểu của chúng nhưng phép toán lại có lỗi Overflow
Như vậy chỗ đỏ đỏ sẽ có lỗi overflow một khi nào đó.
Sub test()
Dim Sarr()
ReDim Sarr(1 To 32000)
For k = 1 To 32000
Sarr(k) = k
Next
Debug.Print NearestValue(16001.6, Sarr)
' Sarr = Array(12, 25, 139, 2343, 1055, 32234, 36789, 40085)
' Debug.Print NearestValue(35000, Sarr)
End Sub
Function NearestValue(ByVal find_value As Double, mang()) As Double
Dim index As Long, Lo As Long, Hi As Long
Lo = LBound(mang)
Hi = UBound(mang)
If find_value < mang(Lo) Or find_value > mang(Hi) Then
MsgBox "Khong tim thay gia tri!"
Exit Function
End If
index = (Lo + Hi) \ 2
Do While mang(index) <> find_value
If index = Lo Then Exit Do
If mang(index) < find_value Then
Lo = index
Else
Hi = index
End If
index = (Lo + Hi) \ 2
Loop
If mang(index) = find_value Then
NearestValue = find_value
Else
If 2 * find_value <= mang(Lo) + mang(Hi) Then
NearestValue = mang(Lo)
Else
NearestValue = mang(Hi)
End If
End If
End Function
Nếu ai test thấy sai sót thì xin góp ý. Chuyện nhầm lẫn là chuyện thường, ai cũng có thể mắc phải. Chỉ có điều sự đời nó là thế này: "Cái lỗi của người khác nhìn cứ như con voi ấy, rõ mồn một. Nhưng cũng lỗi ấy của bản thân thì nhìn nó như con kiến ấy, tìm đi tìm lại mà chả thấy."
1. Tuỳ theo ngôn ngữ mà chuyện tràn số tính khác nhau. Nếu là ngôn ngữ cấp dưới như C/C++ chẳng hạn thì tràn số cho kết quả sai (không nảy sinh error mà chỉ cắt bớt số bits của kết quả). Theo dòng họ BASIC thì tràn số sẽ bị error cho nên cũng không quan trọng lắm. Ở đây đâu có nói chuyện phóng phi thuyền lên vũ trụ. Cách tránh tràn số có hơi phức tạp.
2. Đệ quy tốn bộ nhớ và thời gian kết nối. Điều đó ai sử dụng đệ quy cũng phải biết. Tuỳ theo mức độ trầm trọng của vấn đề mà chúng ta có dùng nó hay không. (chú ý từ "trầm trọng" thay vì "quan trọng")
Đỏ:
Xét lại yêu cầu: tìm một giá trị
Thực tế: Trả về một giá trị là nhiệm vụ của function. Nếu không thì nguời ta đã dùng sub cho khoẻ.
Suy ra: đề bài này dùng function là đúng rồi. Không có cách nào hay hơn nữa.
Tuy nhiên: như tôi đã nói. Chi tiết đề dỏm. Nếu trị dò tìm nằm chính giữa hai trị trong mảng thì lấy lớn hay nhỏ?
Xanh:
Chậm và nhanh không phải là ưu tiên của tôi. Cái này để người khác trả lời. Toi chỉ có thể nói là phương pháp nhị phân chính là để giúp tăng hiệu quả so với cách tìm tuần tự từ đầu mảng.
Khi lập trình ưu tiên của tôi nằm ở kết quả nhìn vào có dễ kiểm soát là đúng hay sai hay không.
Tôi làm việc với dữ liệu nhiều năm. Kinh nghiệm cho biết cái đáng sợ nhất là kết quả sai nhưng không hiện rõ, vài ba tháng/năm sau mới té ra mình dùng dữ liệu sai bét.
Private Type HocSinh
tuoi As Integer
ten As String
End Type
đoạn code này
Mã:
Dim t(1 To 6) As HocSinh
Dim i As Integer
For i = 1 To 6 Step 1
t(i).ten = "abc"
Next
được chấp nhận còn đoạn code này
Mã:
Dim hs As HocSinh
Dim t(1 To 6) As HocSinh
For Each hs In t
hs.ten = "abc"
Next
lại báo lỗi " for each control variable on arrays must be variant "
cái em cần là sử dụng For each vì em xài mảng động
xin cho em biết phải sửa lại ntn
và xin cho biết cách đếm số phần tử hiện tại của 1 mảng động. Cảm ơn
Private Type HocSinh
tuoi As Integer
ten As String
End Type
đoạn code này
Mã:
Dim t(1 To 6) As HocSinh
Dim i As Integer
For i = 1 To 6 Step 1
t(i).ten = "abc"
Next
được chấp nhận còn đoạn code này
Mã:
Dim hs As HocSinh
Dim t(1 To 6) As HocSinh
For Each hs In t
hs.ten = "abc"
Next
lại báo lỗi " for each control variable on arrays must be variant "
cái em cần là sử dụng For each vì em xài mảng động
xin cho em biết phải sửa lại ntn
và xin cho biết cách đếm số phần tử hiện tại của 1 mảng động. Cảm ơn
For Each có thể không được sử dụng trên mảng của Type người dùng định nghĩa hoặc các chuỗi dài cố định (For Each may not be used on array of user-defined type or fixed-length strings). Vì thế trong trường hợp này bạn không nên dùng nó.
Cách tính cận trên (Ubound) và cận dưới (Lbound) của mảng sau đó lấy cận trên trừ cho cận dưới cộng thêm 1 là ra số phần tử trong mảng.
Số phần tử = Ubound(YourArray) - Lbound(YourArray) + 1
Các anh cho e hỏi. E có 1 mãng từ A1:A10. Em muốn tìm giá trị của cell B1 trong mãng nói trên nếu có thì xuất giá trị đó vào cell C1. Em phải code như thế nào vậy các anh
em thành thật xin lỗi , lâu nay ra tiệm net toàn chơi game nên mới bị nhiễm mấy thứ ngôn ngữ này 
