Xác định số phần tử khác o trong mảng

Liên hệ QC
mhung12005

mhung12005

Thành viên chậm chạm
Tham gia
20/7/11
Bài viết
1,598
Được thích
1,261
Nghề nghiệp
Đâu có việc thì làm
Xin chào các thầy và ACE,

Em mò mẫm viết 1 hàm tự tạo như sau:

Mã: 
Function count_T7_CNworkingdays(Rng As Range)
Dim VSouceArray() As Variant, VTmp As Variant, VResultArray() As Variant
Dim lR As Long, n As Long
On Error Resume Next
VSouceArray = Rng.Value
ReDim VResultArray(1 To UBound(VSouceArray, 1), 1 To 1)
With CreateObject("Scripting.Dictionary")
   For lR = 1 To UBound(VSouceArray, 1)
      If VSouceArray(lR, 2) = 0 Then
         If VSouceArray(lR, 1) <> "" Then
            VTmp = VSouceArray(lR, 1)
            If Not .exists(VTmp) Then
               n = n + 1
               .Add VTmp, ""
               VResultArray(n, 1) = VTmp
            End If
         End If
      End If
   Next lR
End With
count_T7_CNworkingdays = VResultArray
End Function

Cũng cho ra kết quả là 1 mảng, chỉ phiền 1 nỗi là mảng này chứa đúng bằng số phần tử mảng nguồn (chỉ số Ubound) mà em không biết làm cách nào để bỏ các phần tử (không cần thiết) đó đi được. Cụ thể như trong file đính kèm, em muốn bỏ đi các phần tử "0" trong mảng trả về của hàm count_T7_CNworkingdays.

Xin được các thầy và các ACE hướng dẫn với ạ. Em xin cảm ơn.
 

File đính kèm

  • test.xlsm
    26.7 KB · Đọc: 16
Sắp xếp theo thời gian sắp xếp theo bầu chọn
mhung12005 đã viết:
Xin chào các thầy và ACE,

Em mò mẫm viết 1 hàm tự tạo như sau:

Mã: 
Function count_T7_CNworkingdays(Rng As Range)
Dim VSouceArray() As Variant, VTmp As Variant, VResultArray() As Variant
Dim lR As Long, n As Long
On Error Resume Next
VSouceArray = Rng.Value
ReDim VResultArray(1 To UBound(VSouceArray, 1), 1 To 1)
With CreateObject("Scripting.Dictionary")
   For lR = 1 To UBound(VSouceArray, 1)
      If VSouceArray(lR, 2) = 0 Then
         If VSouceArray(lR, 1) <> "" Then
            VTmp = VSouceArray(lR, 1)
            If Not .exists(VTmp) Then
               n = n + 1
               .Add VTmp, ""
               VResultArray(n, 1) = VTmp
            End If
         End If
      End If
   Next lR
End With
count_T7_CNworkingdays = VResultArray
End Function

Cũng cho ra kết quả là 1 mảng, chỉ phiền 1 nỗi là mảng này chứa đúng bằng số phần tử mảng nguồn (chỉ số Ubound) mà em không biết làm cách nào để bỏ các phần tử (không cần thiết) đó đi được. Cụ thể như trong file đính kèm, em muốn bỏ đi các phần tử "0" trong mảng trả về của hàm count_T7_CNworkingdays.

Xin được các thầy và các ACE hướng dẫn với ạ. Em xin cảm ơn.
Nhấp chuột vào đây để mở rộng...
Thì vầy thôi:
Mã: 
Function count_T7_CNworkingdays(Rng As Range)
  Dim VSouceArray, VTmp As Variant
  Dim lR As Long
  On Error Resume Next
  VSouceArray = Rng.Value
  With CreateObject("Scripting.Dictionary")
  For lR = 1 To UBound(VSouceArray, 1)
    If VSouceArray(lR, 2) = 0 Then
      VTmp = VSouceArray(lR, 1)
      If Len(VTmp) Then
        If Not .exists(VTmp) Then .Add CLng(VTmp), ""
      End If
    End If
    Next lR
    If .Count Then count_T7_CNworkingdays = .Keys
  End With
End Function
Mã: 
Sub Main()
  Dim Rng As Range
  Dim Arr()
  Set Rng = Sheet2.Range(Sheet2.[B2], Sheet2.[B65536].End(xlUp)).Resize(, 2)
  Arr = count_T7_CNworkingdays(Rng)
  If IsArray(Arr) Then Sheet2.Range("I2").Resize(UBound(Arr, 1), 1).Value = WorksheetFunction.Transpose(Arr)
End Sub
Còn công thức trên bảng tính thì sửa thành: =TRANSPOSE(count_T7_CNworkingdays(B2:C310))
 
Lần chỉnh sửa cuối:
Upvote 0
ndu96081631 đã viết:
Thì vầy thôi:
Mã: 
Function count_T7_CNworkingdays(Rng As Range)
  Dim VSouceArray, VTmp As Variant
  Dim lR As Long
  On Error Resume Next
  VSouceArray = Rng.Value
  With CreateObject("Scripting.Dictionary")
  For lR = 1 To UBound(VSouceArray, 1)
    If VSouceArray(lR, 2) = 0 Then
      VTmp = VSouceArray(lR, 1)
      If Len(VTmp) Then
        If Not .exists(VTmp) Then .Add CLng(VTmp), ""
      End If
    End If
    Next lR
    If .Count Then count_T7_CNworkingdays = .Keys
  End With
End Function
Mã: 
Sub Main()
  Dim Rng As Range
  Dim Arr()
  Set Rng = Sheet2.Range(Sheet2.[B2], Sheet2.[B65536].End(xlUp)).Resize(, 2)
  Arr = count_T7_CNworkingdays(Rng)
  If IsArray(Arr) Then Sheet2.Range("I2").Resize(UBound(Arr, 1), 1).Value = WorksheetFunction.Transpose(Arr)
End Sub
Còn công thức trên bảng tính thì sửa thành: =TRANSPOSE(count_T7_CNworkingdays(B2:C310))
Nhấp chuột vào đây để mở rộng...

Cảm ơn sư phụ nhiều. Đúng là không thày đố mày làm lên. Em mò mẫm đến tận 4h sáng hôm qua mà chẳng ra ngô ra khoai gì.!$@!!.

Mà lúc làm, em cũng gán kết quả hàm = Keys mà chẳng hiểu sao nó cứ lỗi #VALUE. Bây giờ thì em cũng hiểu 1 phần nào rồi.

Xin sư phụ giải thích rõ hơn giúp em cái vụ TRANSPORE này nữa, phải chăng khi add Key vào Dic thì lại là mảng ngang nên mới phải TRANSPORE ? Nhưng sao khi bỏ TRANSPORE ra là nó lỗi #VALUE ?

Chờ tin sư phụ.
 
Upvote 0
mhung12005 đã viết:
Xin sư phụ giải thích rõ hơn giúp em cái vụ TRANSPORE này nữa, phải chăng khi add Key vào Dic thì lại là mảng ngang nên mới phải TRANSPORE
Chờ tin sư phụ.
Nhấp chuột vào đây để mở rộng...

Chính xác là vậy: Keys là mảng 1 chiều (nói theo cách của bạn là NGANG đấy)
mhung12005 đã viết:
Nhưng sao khi bỏ TRANSPORE ra là nó lỗi #VALUE ?
.
Nhấp chuột vào đây để mở rộng...
Tôi có thấy lỗi VALUE gì như bạn nói đâu chứ???
Bỏ TRANSPOSE thì cùng lắm không gán được vào 1 cột thôi (gán theo dòng vẫn OK)
 
Upvote 0
ndu96081631 đã viết:
Chính xác là vậy: Keys là mảng 1 chiều (nói theo cách của bạn là NGANG đấy)

Tôi có thấy lỗi VALUE gì như bạn nói đâu chứ???
Bỏ TRANSPOSE thì cùng lắm không gán được vào 1 cột thôi (gán theo dòng vẫn OK)
Nhấp chuột vào đây để mở rộng...

À đúng rồi, nó bị lỗi là do em vẫn dùng Code của em làm và gán kết quả hàm = Keys luôn nên nó ra VALUE. Sorry sư phụ em nhầm.

Nhưng lại còn thêm vẫn đề nữa là: Em chạy sub Main thì nó chỉ gán có 5 phần tử xuống sheet, trong khi kết quả hàm trả về là 6 phần tử ? Chẳng hiểu sao.

À hay là phần tử đầu tiên của Keys trong Dic luôn được xác định là phần tử thứ 0 mặc dù vẫn có dòng lệnh Option Base 1 nên khi resize(ubound(Arr) thì thì phần tử đẩu tiên không được tính(đếm) ạ thầy ? Vì em dùng Msg để kiểm tra ubound(Arr) thì có giá trị là 5.
 
Lần chỉnh sửa cuối:
Upvote 0
mhung12005 đã viết:
À hay là phần tử đầu tiên của Keys trong Dic luôn được xác định là phần tử thứ 0 mặc dù vẫn có dòng lệnh Option Base 1 nên khi resize(ubound(Arr) thì thì phần tử đẩu tiên không được tính(đếm) ạ thầy ? Vì em dùng Msg để kiểm tra ubound(Arr) thì có giá trị là 5.
Nhấp chuột vào đây để mở rộng...

Bạn nên biết rằng cái Option Base 1 cũng có hạn chế:
- Nó chỉ quy định được Base 1 cho những mảng nào ta tự mình tạo ra
- Nó hoàn toàn không có tác dụng đối với những mảng từ các công cụ khác tạo ra
Vậy nên:
- Dù có Option Base 1 thì mảng từ Dictionary vẫn cứ là Base 0
- Sửa code:
Mã: 
If IsArray(Arr) Then Sheet2.Range("I2").Resize(UBound(Arr, 1), 1).Value = WorksheetFunction.Transpose(Arr)
Thành
Mã: 
If IsArray(Arr) Then Sheet2.Range("I2").Resize(UBound(Arr, 1)[COLOR=#ff0000] [B]+ 1[/B][/COLOR], 1).Value = WorksheetFunction.Transpose(Arr)
(chổ + 1 này tôi viết vội nên có sơ sót)
 
Upvote 0
ndu96081631 đã viết:
Bạn nên biết rằng cái Option Base 1 cũng có hạn chế:
- Nó chỉ quy định được Base 1 cho những mảng nào ta tự mình tạo ra
- Nó hoàn toàn không có tác dụng đối với những mảng từ các công cụ khác tạo ra
Vậy nên:
- Dù có Option Base 1 thì mảng từ Dictionary vẫn cứ là Base 0
- Sửa code:
Mã: 
If IsArray(Arr) Then Sheet2.Range("I2").Resize(UBound(Arr, 1), 1).Value = WorksheetFunction.Transpose(Arr)
Thành
Mã: 
If IsArray(Arr) Then Sheet2.Range("I2").Resize(UBound(Arr, 1)[COLOR=#ff0000] [B]+ 1[/B][/COLOR], 1).Value = WorksheetFunction.Transpose(Arr)
(chổ + 1 này tôi viết vội nên có sơ sót)
Nhấp chuột vào đây để mở rộng...

Vâng em hiểu rồi. Vậy là cái em nghi ngờ cũng đúng như vậy. Cảm ơn sư phụ nhiều.
 
Upvote 0
Sẵn chủ đề anh mhung12005 ,e xin phép cũng hỏi 1 câu giống như a, tuy nhiên nó có liên quan tới thằng combobox !

Lúc đầu, mục đích của e là lọc những ký hiệu phát sinh cho vào combobox, tuy nhiên, giống như a mhung12005 , e cũng redim mảng kết quả có số phần tử bằng mảng gốc thì nó lúc cho vào combobox nó cho luôn những kết quả rỗng. Code e viết như sau :
PHP: 
Private Sub cb3_DropButtonClick()Dim i As Long, j As LongDim arr(), kq()Application.ScreenUpdating = Falsearr = Sheet1.Range("B24:E31").ValueReDim kq(1 To UBound(arr, 1), 1 To 2)For i = 1 To UBound(arr, 1)    If arr(i, 4) = 1 Then        j = j + 1        kq(j, 1) = CStr(arr(i, 1))        kq(j, 2) = CStr(arr(i, 2))    End IfNext iIf j Then    cb3.List() = kqElse    MsgBox " khong phat sinh"End IfApplication.ScreenUpdating = True
End Sub

Sau khi mày mò trên diển đàn thì e vận dụng Redim presever để sau đó transpose nó vào combobox. Tất cả đều không có gì để nói nhưng nếu chỉ có 1 ký hiệu phát sinh trong tháng thì nó lại ra sai. E đã mày mò máy ngày nay mà không có kết quả. Sẵn có bài này, e mạn phép post câu hỏi và mong các A/ Chị và các Thầy hướng dẫn giúp e!

E cám ơn !
 

File đính kèm

  • Hoi GPE.xls
    46.5 KB · Đọc: 7
Upvote 0
quocphuoc88 đã viết:
Sẵn chủ đề anh mhung12005 ,e xin phép cũng hỏi 1 câu giống như a, tuy nhiên nó có liên quan tới thằng combobox !

Lúc đầu, mục đích của e là lọc những ký hiệu phát sinh cho vào combobox, tuy nhiên, giống như a mhung12005 , e cũng redim mảng kết quả có số phần tử bằng mảng gốc thì nó lúc cho vào combobox nó cho luôn những kết quả rỗng. Code e viết như sau :
PHP: 
Private Sub cb3_DropButtonClick()Dim i As Long, j As LongDim arr(), kq()Application.ScreenUpdating = Falsearr = Sheet1.Range("B24:E31").ValueReDim kq(1 To UBound(arr, 1), 1 To 2)For i = 1 To UBound(arr, 1)    If arr(i, 4) = 1 Then        j = j + 1        kq(j, 1) = CStr(arr(i, 1))        kq(j, 2) = CStr(arr(i, 2))    End IfNext iIf j Then    cb3.List() = kqElse    MsgBox " khong phat sinh"End IfApplication.ScreenUpdating = True
End Sub

Sau khi mày mò trên diển đàn thì e vận dụng Redim presever để sau đó transpose nó vào combobox. Tất cả đều không có gì để nói nhưng nếu chỉ có 1 ký hiệu phát sinh trong tháng thì nó lại ra sai. E đã mày mò máy ngày nay mà không có kết quả. Sẵn có bài này, e mạn phép post câu hỏi và mong các A/ Chị và các Thầy hướng dẫn giúp e!

E cám ơn !
Nhấp chuột vào đây để mở rộng...
Nói ra dái dòng, chỉ ngắn gọn thế này: Trường hợp của bạn thì không nên dùng TRANSPOSE
Code sửa lại:
Mã: 
Private Sub cb1_DropButtonClick()
  Dim i As Long, j As Long
  Dim arr(), kq(), aPos()
  arr = Sheet1.Range("B7:E14").Value
  ReDim kq(1 To 2, 1 To UBound(arr, 1))
  Application.EnableEvents = False
  For i = 1 To UBound(arr, 1)
    If arr(i, 4) = 1 Then
      j = j + 1
      ReDim Preserve aPos(1 To j)
      aPos(j) = i
    End If
  Next
  If j Then
    ReDim kq(1 To j, 1 To 2)
    For i = 1 To j
      kq(i, 1) = CStr(arr(aPos(i), 1))
      kq(i, 2) = CStr(arr(aPos(i), 2))
    Next
  End If
  cb1.List() = kq
End Sub
Vòng lập For đầu tiên đề đánh dấu các vị trí cần lấy dữ liệu
Vòng lập For thứ hai mới tiến hành ReDim mảng vừa đủ và nạp dữ liệu vào
 
Upvote 0
Bạn phải đăng nhập hoặc đăng ký để trả lời bài viết tại đây.
Web KT

Bài viết mới nhất

vuongnlks
Lấy dữ liệu 1 cột cụ thể theo ngày từ nhiều file CSV ứng với mã tương ứng trong cột MA CO PHIEU
Trả lời
1
Đọc
43
BuiQuangThuan
B
Salem999999999
Lọc dữ liệu có điều kiện
2
Trả lời
24
Đọc
512
thanthanhan
T
V
Hỗ trợ hàm Sumproduct và Subtotal trong GG Sheets
Trả lời
3
Đọc
212
nguyenngocphuongsw
nguyenngocphuongsw
son0611excel
  • Question
VBA tra cứu hình theo điều kiện
Trả lời
10
Đọc
197
tle2003
T
K
Tính tổng có điều kiện
Trả lời
4
Đọc
153
kimson_nb
K
Xem thêm…

Facebook

Giaiphapexcel.com

Group

DIỄN ĐÀN GIẢI PHÁP EXCEL Group 1
DIỄN ĐÀN GIẢI PHÁP EXCEL Group 2

Thành viên có số lượng bài viết cao nhất tháng

Thành viên có điểm tương tác cao nhất tháng

Back
Top Bottom