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

viehoai · 24/3/11

Xin các anh chị giúp đỡ Code Gán các giá trị của một Range là các phần tử của Mãng
Ví dụ: Tôi có các giá trị của Range("A1:A10"). Tôi muốn viết code để gán giá trị của các cells từ A1:A10 là các phần tử của Mãng Arr chẳn hạn.
Xin cảm ơn các anh chị

ndu96081631 · 5/11/12

bi bô đã viết:
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

Bạn đưa code lên cũng chẳng giúp ích được gì đâu. Cái điều quan trọng mà mọi người cần biết là Text trong cột B đang được sắp xếp kiểu gi

Bi Bo · 5/11/12

ndu96081631 đã viết:
Bạn đưa code lên cũng chẳng giúp ích được gì đâu. Cái điều quan trọng mà mọi người cần biết là Text trong cột B đang được sắp xếp kiểu gi

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

ndu96081631 · 5/11/12

bi bô đã viết:
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ả

Bi Bo · 5/11/12

ndu96081631 đã viết:
Đị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ả

Trời, mình toàn hì hụi cầm dao phay mổ trâu...hic
Cám ơn NDU

Bi Bo · 7/11/12

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

ndu96081631 · 7/11/12

bi bô đã viết:

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?

Bi Bo · 7/11/12

ndu96081631 đã viết:
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

Link này tôi đã hỏi tại đây.
http://www.giaiphapexcel.com/forum/...heo-ngày-(From-To-)-từ-2-sheet-với-excel-2007

ndu96081631 · 7/11/12

bi bô đã viết:
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

Link này tôi đã hỏi tại đây.
http://www.giaiphapexcel.com/forum/showthread.php?73311-Nh%E1%BB%9D-h%C6%B0%E1%BB%9Bng-d%E1%BA%ABn-l%C3%A0m-PIVOT-theo-ng%C3%A0y-%28From-To-%29-t%E1%BB%AB-2-sheet-v%E1%BB%9Bi-excel-2007

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ỏ

Bi Bo · 7/11/12

ndu96081631 đã viết:
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ỏ

Cám ơn Bác NDU
tôi định quay ra cho vào 1 sheet (nhưng trường hợp file share dùng chung giữa 2 người, ngại trường hợp dữ liệu bị đè lên nhau)

Cám ơn Bác, PIVOT rất hay nhưng tôi cũng không khoái lắm, định mày mò học mà khó quá

chelsea FC · 8/11/12

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!

Bi Bo · 8/11/12

Bi Bô đang tập mảng và thử ghép 2 cột lại với nhau, dán nó vào cột khác
Nghịch một code như sau nhưng nó báo lỗi

Các Bác sửa lại giúp Bi Bô

PHP:

Sub ghep()


Dim SArr
SArr = Range("A3:J" & [J65000].End(xlUp).Row).Value
ReDim Arr(1 To UBound(SArr()), 1 To 1)
For i = 1 To UBound(SArr(), 1)
SArr(i, 3) = SArr(i, 3) & SArr(i, 4) ' cot 3 = cot 3 & cot 4
SArr(i, 1) = SArr(i, 9) & SArr(i, 3) ' cot 1 = cot 9  & cot 3
Arr(i, 1) = SArr(i, 1)
Next i
Range("A3:A" & [J65000].End(xlUp).Row).Value = Arr

End Sub

viehoai · 8/11/12

bi bô đã viết:
Bi Bô đang tập mảng và thử ghép 2 cột lại với nhau, dán nó vào cột khác
Nghịch một code như sau nhưng nó báo lỗi

Các Bác sửa lại giúp Bi Bô

PHP:

Sub ghep() Dim SArr SArr = Range("A3:J" & [J65000].End(xlUp).Row).Value ReDim Arr(1 To UBound(SArr()), 1 To 1) For i = 1 To UBound(SArr(), 1) SArr(i, 3) = SArr(i, 3) & SArr(i, 4) ' cot 3 = cot 3 & cot 4 SArr(i, 1) = SArr(i, 9) & SArr(i, 3) ' cot 1 = cot 9 & cot 3 Arr(i, 1) = SArr(i, 1) Next i Range("A3:A" & [J65000].End(xlUp).Row).Value = Arr End Sub

1. Bạn đã dim Arr() đâu mà ReDim?
2. Bạn chỉ muốn xuất Arr thôi thì thêm lệnh: SArr(i, 3) = SArr(i, 3) & SArr(i, 4) làm gì?
3. Sao không gán Arr(i, 1) = SArr(i, 9) & SArr(i, 3) mà gán SArr(i, 1) = SArr(i, 9) & SArr(i, 3) để rồi phải thêm lệnh Arr(i, 1) = SArr(i, 1)
4. Range("A3:A" & [J65000].End(xlUp).Row).Value = Arr nên sửa lại Range("A3").Resize (UBound(arr)).Value = Arr

ndu96081631 · 8/11/12

bi bô đã viết:
Bi Bô đang tập mảng và thử ghép 2 cột lại với nhau, dán nó vào cột khác
Nghịch một code như sau nhưng nó báo lỗi

Các Bác sửa lại giúp Bi Bô

PHP:

Sub ghep() Dim SArr SArr = Range("A3:J" & [J65000].End(xlUp).Row).Value ReDim Arr(1 To UBound(SArr()), 1 To 1) For i = 1 To UBound(SArr(), 1) SArr(i, 3) = SArr(i, 3) & SArr(i, 4) ' cot 3 = cot 3 & cot 4 SArr(i, 1) = SArr(i, 9) & SArr(i, 3) ' cot 1 = cot 9 & cot 3 Arr(i, 1) = SArr(i, 1) Next i Range("A3:A" & [J65000].End(xlUp).Row).Value = Arr End Sub

Sửa chổ này

Mã:

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

-----------------------------------------

viehoai đã viết:
1. Bạn đã dim Arr() đâu mà ReDim?

Cái này được à nghen ---> Khỏi Dim cũng ReDim được đấy

Bi Bo · 8/11/12

ndu96081631 đã viết:
Sửa chổ này

Mã:

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

Hay quá...Bi Bô làm được rồi
Cám ơn Viêt Hoài & NDU nhiều

Bi Bo · 9/11/12

Trong hàm diengiai của Tác Giả NDU,

PHP:

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é

hongquanjp · 21/6/13

Hỏi về mảng- Array !!!

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

ndu96081631 · 21/6/13

hongquanjp đã viết:
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

hongquanjp · 21/6/13

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è

ndu96081631 · 21/6/13

hongquanjp đã viết:
mà không hiểu cái hàm Cstr của thầy nó có công dụng gì nhỉ ?

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)

hongquanjp đã viết:
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è

Nói gì hổng hiểu gì hết trơn

hongquanjp · 21/6/13

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à...

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

Thành viên gắn bó

Huyền thoại GPE

Thành viên mới

Huyền thoại GPE

Thành viên mới

Thành viên mới

File đính kèm

Huyền thoại GPE

Thành viên mới

Huyền thoại GPE

Thành viên mới

Thành viên mới

Thành viên mới

Thành viên gắn bó

Huyền thoại GPE

Thành viên mới

Thành viên mới

Thành viên mới

File đính kèm

Huyền thoại GPE

Thành viên mới

Huyền thoại GPE

Thành viên mới