Lỗi dò tìm hệ số

Liên hệ QC
T

thao nguyen01

Thành viên thường trực
Tham gia
8/12/19
Bài viết
214
Được thích
25
Kính gửi anh/chị trên diễn đàn,

Em viết code dò tìm hệ số dựa vào Mã nhân viên. Nhưng khi em viết xong, chạy kết quả thì kết quả chưa đúng. Em tìm hoài nhưng không biết nguyên nhân do đâu. Em nghĩ do bảng dò có số thập phân. Em có đính kèm file bên dưới ạ. Anh/chị xem giúp em ạ. Em cảm ơn anh/chị ạ.

Sub thongke03(Dic As Object)
Dim I As Long, dcuoi As Long, j As Double
Dim arr_N()

dcuoi = Sheet1.Range("K10000").End(xlUp).Row
arr_N = Sheet1.Range("K4:p" & dcuoi)

ReDim arr_D(1 To UBound(arr_N, 1), 1 To 12)
For I = 1 To UBound(arr_N, 1)
For j = arr_N(I, 1) To arr_N(I, 2)
If Not Dic.exists(j) Then
Dic.Add j, I
Dic.Item(j) = I
End If
Next
Next

End Sub


Sub dotim()
Dim I As Long, dcuoi As Long, j As Long, ii As Long
Dim arr_N()
Dim arr_D()
Dim Dic As Object
Set Dic = CreateObject("scripting.dictionary")
Set Dic01 = CreateObject("scripting.dictionary")
Call thongke03(Dic)
dcuoi = Sheet1.Range("D10000").End(xlUp).Row
arr_N = Sheet1.Range("D2:H" & dcuoi)

dcuoi02 = Sheet1.Range("K10000").End(xlUp).Row
arr_N02 = Sheet1.Range("K4:p" & dcuoi02)
ReDim arr_D(1 To UBound(arr_N, 1), 1 To 2)

'''''''''''''''''
dcuoi_DS = Sheet1.Range("Q10000").End(xlUp).Row
arr_DS = Sheet1.Range("Q4:R" & dcuoi_DS)

For I = 1 To UBound(arr_DS, 1)
If Not Dic01.exists(arr_DS(I, 1)) Then
Dic01.Add arr_DS(I, 1), arr_DS(I, 2)
End If
Next

'''''''''''''''''''''''''

For I = 1 To UBound(arr_N, 1)
arr_D(I, 1) = Right(arr_N(I, 1), 1)
If Dic.exists(Right(arr_N(I, 1), 1) * 1) Then
j = Dic.Item(Right(arr_N(I, 1), 1) * 1)
If Dic01.exists(Left(arr_N(I, 1), 1)) Then
JJ = Dic01.Item(Left(arr_N(I, 1), 1))
arr_D(I, 2) = arr_N02(j, JJ + 2)
End If
End If
Next
Sheet1.Range("H2:I1000").ClearContents
Sheet1.Range("H2").Resize(UBound(arr_N, 1), 2) = arr_D
End Sub
 

File đính kèm

  • Book1.xlsb
    18.4 KB · Đọc: 14
Sắp xếp theo thời gian sắp xếp theo bầu chọn
thao nguyen01 đã viết:
Kính gửi anh/chị trên diễn đàn,

Em viết code dò tìm hệ số dựa vào Mã nhân viên. Nhưng khi em viết xong, chạy kết quả thì kết quả chưa đúng. Em tìm hoài nhưng không biết nguyên nhân do đâu. Em nghĩ do bảng dò có số thập phân. Em có đính kèm file bên dưới ạ. Anh/chị xem giúp em ạ. Em cảm ơn anh/chị ạ.

Sub thongke03(Dic As Object)
Dim I As Long, dcuoi As Long, j As Double
Dim arr_N()

dcuoi = Sheet1.Range("K10000").End(xlUp).Row
arr_N = Sheet1.Range("K4:p" & dcuoi)

ReDim arr_D(1 To UBound(arr_N, 1), 1 To 12)
For I = 1 To UBound(arr_N, 1)
For j = arr_N(I, 1) To arr_N(I, 2)
If Not Dic.exists(j) Then
Dic.Add j, I
Dic.Item(j) = I
End If
Next
Next

End Sub


Sub dotim()
Dim I As Long, dcuoi As Long, j As Long, ii As Long
Dim arr_N()
Dim arr_D()
Dim Dic As Object
Set Dic = CreateObject("scripting.dictionary")
Set Dic01 = CreateObject("scripting.dictionary")
Call thongke03(Dic)
dcuoi = Sheet1.Range("D10000").End(xlUp).Row
arr_N = Sheet1.Range("D2:H" & dcuoi)

dcuoi02 = Sheet1.Range("K10000").End(xlUp).Row
arr_N02 = Sheet1.Range("K4:p" & dcuoi02)
ReDim arr_D(1 To UBound(arr_N, 1), 1 To 2)

'''''''''''''''''
dcuoi_DS = Sheet1.Range("Q10000").End(xlUp).Row
arr_DS = Sheet1.Range("Q4:R" & dcuoi_DS)

For I = 1 To UBound(arr_DS, 1)
If Not Dic01.exists(arr_DS(I, 1)) Then
Dic01.Add arr_DS(I, 1), arr_DS(I, 2)
End If
Next

'''''''''''''''''''''''''

For I = 1 To UBound(arr_N, 1)
arr_D(I, 1) = Right(arr_N(I, 1), 1)
If Dic.exists(Right(arr_N(I, 1), 1) * 1) Then
j = Dic.Item(Right(arr_N(I, 1), 1) * 1)
If Dic01.exists(Left(arr_N(I, 1), 1)) Then
JJ = Dic01.Item(Left(arr_N(I, 1), 1))
arr_D(I, 2) = arr_N02(j, JJ + 2)
End If
End If
Next
Sheet1.Range("H2:I1000").ClearContents
Sheet1.Range("H2").Resize(UBound(arr_N, 1), 2) = arr_D
End Sub
Nhấp chuột vào đây để mở rộng...
Nêu rõ yêu cầu và kết quả đúng cần có, chứ đừng bắt người khác phải đọc code của bạn mà code đấy không cho kết quả đúng.
 
Upvote 0
Ba Tê đã viết:
Nêu rõ yêu cầu và kết quả đúng cần có, chứ đừng bắt người khác phải đọc code của bạn mà code đấy không cho kết quả đúng.
Nhấp chuột vào đây để mở rộng...

Dạ, trong file của con có cột D ạ, ký tự đầu tiên là mã loại, ký tự thứ 2 là số năm công tác ạ, 2 ký tự này con dùng để dò bên bảng dò K3:p7 (K4:L7 là dò tìm trong khoảng của số năm công tác ạ). Con tính bằng tay kết quả ở cột J (cột J con sai ạ). Kết quả con viết code con sẽ cho kết quả cột H (số năm công tác), cột I (hệ số) ạ. Bác xem giúp con ạ. Con cảm ơn Bác ạ.
 
Upvote 0
thao nguyen01 đã viết:
Dạ, trong file của con có cột D ạ, ký tự đầu tiên là mã loại, ký tự thứ 2 là số năm công tác ạ, 2 ký tự này con dùng để dò bên bảng dò K3:p7 (K4:L7 là dò tìm trong khoảng của số năm công tác ạ). Con tính bằng tay kết quả ở cột J (cột J con sai ạ). Kết quả con viết code con sẽ cho kết quả cột H (số năm công tác), cột I (hệ số) ạ. Bác xem giúp con ạ. Con cảm ơn Bác ạ.
Nhấp chuột vào đây để mở rộng...
Bạn chạy thử Sub này coi sao:
PHP: 
Public Sub s_Gpe()
Dim sArr(), dArr(), tArr()
Dim I As Long, J As Long, N As Long, R As Long
    sArr = Range("D2", Range("D2").End(xlDown)).Value
    R = UBound(sArr)
    tArr = Range("L3:P7").Value
ReDim dArr(1 To R, 1 To 2)
    For I = 1 To R
        dArr(I, 1) = Val(Mid(sArr(I, 1), 2))
        For N = 2 To UBound(tArr)
            If dArr(I, 1) <= tArr(N, 1) Then
                For J = 2 To 5
                    If tArr(1, J) = Left(sArr(I, 1), 1) Then
                        dArr(I, 2) = tArr(N, J)
                        Exit For
                    End If
                Next J
                Exit For
            End If
        Next N
    Next I
Range("H2").Resize(R, 2) = dArr
End Sub
 
Upvote 0
Ba Tê đã viết:
Bạn chạy thử Sub này coi sao:
Nhấp chuột vào đây để mở rộng...
Em đoán 99% không hợp ý bạn ấy rồi. Bởi bạn ấy chỉ quan tâm Dic thôi, từ bài hôm qua đó anh.

www.giaiphapexcel.com

Tính điểm trung bình với môn chuyên nhân đôi bằng VBA

Kính gửi anh/chị trên diễn đàn, Em muốn tính điểm trung bình với môn chuyên được nhân đôi bằng VBA. Em có mô tả trong file đính kèm ạ. Anh/chị xem giúp em với ạ. Em cảm ơn nhiều ạ
www.giaiphapexcel.com www.giaiphapexcel.com
 
Upvote 0
befaint đã viết:
Em đoán 99% không hợp ý bạn ấy rồi. Bởi bạn ấy chỉ quan tâm Dic thôi, từ bài hôm qua đó anh.
Nhấp chuột vào đây để mở rộng...
Cái này là VLookup và Match mà.
Nếu muốn code thì cứ lấy nguyên cái range ấy rồi Application.VLookup...
Chả thấy lý do gì phải đít cả. Mà bảo đít thì tôi cũng bí, chả biết đâu làm làm.

Hình như thớt bị tương tư cái đít. Ăn cũng thấy, ngủ cũng thấy đít.
 
Upvote 0
Ba Tê đã viết:
Bạn chạy thử Sub này coi sao:
PHP: 
Public Sub s_Gpe()
Dim sArr(), dArr(), tArr()
Dim I As Long, J As Long, N As Long, R As Long
    sArr = Range("D2", Range("D2").End(xlDown)).Value
    R = UBound(sArr)
    tArr = Range("L3:P7").Value
ReDim dArr(1 To R, 1 To 2)
    For I = 1 To R
        dArr(I, 1) = Val(Mid(sArr(I, 1), 2))
        For N = 2 To UBound(tArr)
            If dArr(I, 1) <= tArr(N, 1) Then
                For J = 2 To 5
                    If tArr(1, J) = Left(sArr(I, 1), 1) Then
                        dArr(I, 2) = tArr(N, J)
                        Exit For
                    End If
                Next J
                Exit For
            End If
        Next N
    Next I
Range("H2").Resize(R, 2) = dArr
End Sub
Nhấp chuột vào đây để mở rộng...

Dạ, con cảm ơn Bác ạ. Kết quả ra đúng ạ. Nhưng con có thắc mắc là với đoạn code của con ở trên. Khi con chỉnh lại K5:K7, con chỉnh lại số nguyên lần lượt là 2, 5, 8, thì kết quả lại ra đúng. Con viết code bài trên theo cách viết bài "Dò tìm giảm giá" trước đây ở link đính kèm ạ. Nhưng con thử nhiều trường hợp thì số nguyên ra, còn số thập phân thì con làm không đúng. Nên con không biết con sai chỗ nào để sửa ạ.

For I = 1 To UBound(arr_N, 1)
For j = arr_N(I, 1) To arr_N(I, 2)
If Not Dic.exists(j) Then
Dic.Add j, I
Dic.Item(j) = I
End If
Next
Next

Con đã lưu giá trị vào đây nhưng khi dò thì lại báo lỗi không tồn tại trong Dic ạ. Con cảm ơn Bác đã xem và giúp con ạ.

www.giaiphapexcel.com

Dò tìm giảm giá bằng VBA

Kính gửi anh/chị trên diễn đàn, Em đang bị vướng vấn đề sau ạ: Em muốn dò tìm cột giảm giá trong sheet Danh muc: Nếu ngày bên sheet Thống kê nằm trong khoảng ngày của Danh mục thì sẽ lấy cột Giảm giá ạ. Em có viết code nhưng chưa ra ạ. Anh/chị xem giúp em ạ. Em cảm ơn nhiều ạ. Sub...
www.giaiphapexcel.com www.giaiphapexcel.com
 

File đính kèm

  • Book1.xlsb
    19.4 KB · Đọc: 3
Upvote 0
VetMini đã viết:
Cái này là VLookup và Match mà.
Nếu muốn code thì cứ lấy nguyên cái range ấy rồi Application.VLookup...
Chả thấy lý do gì phải đít cả. Mà bảo đít thì tôi cũng bí, chả biết đâu làm làm.

Hình như thớt bị tương tư cái đít. Ăn cũng thấy, ngủ cũng thấy đít.
Nhấp chuột vào đây để mở rộng...

Dạ, em cảm ơn Thầy ạ. Em sẽ khắc phục, học hỏi thêm để hiểu khi nào cần dùng Dic, khi nào không cần ạ. Vì kiến thức em còn hạn chế, nên thường em sẽ viết theo cách em thường dùng, nhưng thực sự không thể áp dụng rập khuôn và giống nhau được ạ. Em cảm ơn Thầy nhiều ạ.
Bài đã được tự động gộp:

befaint đã viết:
Tới bài trên thì chắc 100% là chỉ hỏi Dic rồi đó anh. :D

View attachment 235106
Nhấp chuột vào đây để mở rộng...

Dạ, em cảm ơn anh nhiều ạ. Em sẽ thay đổi và học hỏi thêm để có thể áp dụng và giải quyết công việc ạ, không nhất thiết 1 cách là Dic ạ. Em cảm ơn anh ạ.
 
Upvote 0
Chủ đề là dò tìm trong khoảng. Điển hình, hạng A, từ x năm đến y năm...

Dictionary vốn căn cản từ định nghĩa của nó là phép chiếu 1-1. Tức là dò tìm chính xác.

Rõ ràng là đem xe tăng đi kéo cày.
Mã: 
' code đơn giản, nếu dữ liệu tùm lum và muốn bẫy lỗi thì phải tự thêm vào
dongCuoi = ... ' code tìm dòng cuối ở đây
a = Application.Transpose(Range("D2:D" & dongCuoi).Value)
dongCuoi = UBound(a)
Redim b(1 To dongCuoi, 1 to 3)
Set bangDo = Range("K4:p7")
Set bangLoai = Range("K3:p3")
For i = 1 To dongCuoi
  b(i, 1) = Left(a(i), 1)
  b(i, 2) = Val(Right(a(i), Len(a(i))-1)
  b(i, 3) = Application.VLookup(b(i, 2), bangDo, Application.Match(b(i, 1), bangLoai, 0), 1)
Next i
Range("G2:I2").Resize(dongCuoi, ).Value = b
 
Upvote 0
VetMini đã viết:
Chủ đề là dò tìm trong khoảng. Điển hình, hạng A, từ x năm đến y năm...

Dictionary vốn căn cản từ định nghĩa của nó là phép chiếu 1-1. Tức là dò tìm chính xác.

Rõ ràng là đem xe tăng đi kéo cày.
Mã: 
' code đơn giản, nếu dữ liệu tùm lum và muốn bẫy lỗi thì phải tự thêm vào
dongCuoi = ... ' code tìm dòng cuối ở đây
a = Application.Transpose(Range("D2:D" & dongCuoi).Value)
dongCuoi = UBound(a)
Redim b(1 To dongCuoi, 1 to 3)
Set bangDo = Range("K4:p7")
Set bangLoai = Range("K3:p3")
For i = 1 To dongCuoi
  b(i, 1) = Left(a(i), 1)
  b(i, 2) = Val(Right(a(i), Len(a(i))-1)
  b(i, 3) = Application.VLookup(b(i, 2), bangDo, Application.Match(b(i, 1), bangLoai, 0), 1)
Next i
Range("G2:I2").Resize(dongCuoi, ).Value = b
Nhấp chuột vào đây để mở rộng...

Dạ, em hiểu ý Thầy ạ. Em cảm ơn Thầy nhiều ạ.
 
Upvote 0
thao nguyen01 đã viết:
Kính gửi anh/chị trên diễn đàn,

Em viết code dò tìm hệ số dựa vào Mã nhân viên. Nhưng khi em viết xong, chạy kết quả thì kết quả chưa đúng. Em tìm hoài nhưng không biết nguyên nhân do đâu. Em nghĩ do bảng dò có số thập phân. Em có đính kèm file bên dưới ạ. Anh/chị xem giúp em ạ. Em cảm ơn anh/chị ạ.

Sub thongke03(Dic As Object)
Dim I As Long, dcuoi As Long, j As Double
Dim arr_N()

dcuoi = Sheet1.Range("K10000").End(xlUp).Row
arr_N = Sheet1.Range("K4:p" & dcuoi)

ReDim arr_D(1 To UBound(arr_N, 1), 1 To 12)
For I = 1 To UBound(arr_N, 1)
For j = arr_N(I, 1) To arr_N(I, 2)
If Not Dic.exists(j) Then
Dic.Add j, I
Dic.Item(j) = I
End If
Next
Next

End Sub


Sub dotim()
Dim I As Long, dcuoi As Long, j As Long, ii As Long
Dim arr_N()
Dim arr_D()
Dim Dic As Object
Set Dic = CreateObject("scripting.dictionary")
Set Dic01 = CreateObject("scripting.dictionary")
Call thongke03(Dic)
dcuoi = Sheet1.Range("D10000").End(xlUp).Row
arr_N = Sheet1.Range("D2:H" & dcuoi)

dcuoi02 = Sheet1.Range("K10000").End(xlUp).Row
arr_N02 = Sheet1.Range("K4:p" & dcuoi02)
ReDim arr_D(1 To UBound(arr_N, 1), 1 To 2)

'''''''''''''''''
dcuoi_DS = Sheet1.Range("Q10000").End(xlUp).Row
arr_DS = Sheet1.Range("Q4:R" & dcuoi_DS)

For I = 1 To UBound(arr_DS, 1)
If Not Dic01.exists(arr_DS(I, 1)) Then
Dic01.Add arr_DS(I, 1), arr_DS(I, 2)
End If
Next

'''''''''''''''''''''''''

For I = 1 To UBound(arr_N, 1)
arr_D(I, 1) = Right(arr_N(I, 1), 1)
If Dic.exists(Right(arr_N(I, 1), 1) * 1) Then
j = Dic.Item(Right(arr_N(I, 1), 1) * 1)
If Dic01.exists(Left(arr_N(I, 1), 1)) Then
JJ = Dic01.Item(Left(arr_N(I, 1), 1))
arr_D(I, 2) = arr_N02(j, JJ + 2)
End If
End If
Next
Sheet1.Range("H2:I1000").ClearContents
Sheet1.Range("H2").Resize(UBound(arr_N, 1), 2) = arr_D
End Sub
Nhấp chuột vào đây để mở rộng...
Muốn Dic có Dic
Mã: 
Sub dotim()
  Dim i As Long
  Dim sArr(), Res(), Dic As Object
 
  Set Dic = CreateObject("scripting.dictionary")
  Call CreateDic(Dic)
  sArr = Sheet1.Range("G2:H" & Sheet1.Range("D10000").End(xlUp).Row).Value
  ReDim Res(1 To UBound(sArr, 1), 1 To 1)
  For i = 1 To UBound(sArr, 1)
    Res(i, 1) = Dic.Item(sArr(i, 1) & sArr(i, 2))
  Next
  Sheet1.Range("I2:I1000").ClearContents
  Sheet1.Range("I2").Resize(UBound(sArr, 1)) = Res
End Sub

Sub CreateDic(Dic)
  Dim i As Long, j As Long, c As Long, cMin&
  Dim sArr()
 
  sArr = Sheet1.Range("K3:P" & Sheet1.Range("K10000").End(xlUp).Row).Value
  For i = 2 To UBound(sArr, 1)
    For c = cMin To sArr(i, 2)
      For j = 3 To 6
        Dic.Item(sArr(1, j) & c) = sArr(i, j)
      Next j
    Next c
    cMin = sArr(i, 2) + 1
  Next i
End Sub
 
Upvote 0
thao nguyen01 đã viết:
Dạ, em hiểu ý Thầy ạ. Em cảm ơn Thầy nhiều ạ.
Nhấp chuột vào đây để mở rộng...
Bài này nếu dùng Dic thì phải nạp vào Dic đầy đủ các Keys,
Trường hợp này là A,B,C,D phải có Key từ A0, A0.5, A1, A1.5, ... đến A30 tương tự với B,C,D.
Code của bạn không thể tìm Key "trong khoảng" được.
 
Upvote 0
HieuCD đã viết:
Muốn Dic có Dic
Mã: 
Sub dotim()
  Dim i As Long
  Dim sArr(), Res(), Dic As Object

  Set Dic = CreateObject("scripting.dictionary")
  Call CreateDic(Dic)
  sArr = Sheet1.Range("G2:H" & Sheet1.Range("D10000").End(xlUp).Row).Value
  ReDim Res(1 To UBound(sArr, 1), 1 To 1)
  For i = 1 To UBound(sArr, 1)
    Res(i, 1) = Dic.Item(sArr(i, 1) & sArr(i, 2))
  Next
  Sheet1.Range("I2:I1000").ClearContents
  Sheet1.Range("I2").Resize(UBound(sArr, 1)) = Res
End Sub

Sub CreateDic(Dic)
  Dim i As Long, j As Long, c As Long, cMin&
  Dim sArr()

  sArr = Sheet1.Range("K3:P" & Sheet1.Range("K10000").End(xlUp).Row).Value
  For i = 2 To UBound(sArr, 1)
    For c = cMin To sArr(i, 2)
      For j = 3 To 6
        Dic.Item(sArr(1, j) & c) = sArr(i, j)
      Next j
    Next c
    cMin = sArr(i, 2) + 1
  Next i
End Sub
Nhấp chuột vào đây để mở rộng...

Dạ, em cảm ơn Thầy nhiều ạ. Em chạy code báo là lỗi Type Mismatch ạ. Em bấm Debug thì lỗi dòng For c = cMin To sArr(i, 2) ạ.
Bài đã được tự động gộp:

Ba Tê đã viết:
Bài này nếu dùng Dic thì phải nạp vào Dic đầy đủ các Keys,
Trường hợp này là A,B,C,D phải có Key từ A0, A0.5, A1, A1.5, ... đến A30 tương tự với B,C,D.
Code của bạn không thể tìm Key "trong khoảng" được.
Nhấp chuột vào đây để mở rộng...

Dạ, code con viết chưa nạp đủ key ạ. Con hiểu nguyên nhân rồi ạ. Con cảm ơn Bác ạ.
Bài đã được tự động gộp:

VetMini đã viết:
Chủ đề là dò tìm trong khoảng. Điển hình, hạng A, từ x năm đến y năm...

Dictionary vốn căn cản từ định nghĩa của nó là phép chiếu 1-1. Tức là dò tìm chính xác.

Rõ ràng là đem xe tăng đi kéo cày.
Mã: 
' code đơn giản, nếu dữ liệu tùm lum và muốn bẫy lỗi thì phải tự thêm vào
dongCuoi = ... ' code tìm dòng cuối ở đây
a = Application.Transpose(Range("D2:D" & dongCuoi).Value)
dongCuoi = UBound(a)
Redim b(1 To dongCuoi, 1 to 3)
Set bangDo = Range("K4:p7")
Set bangLoai = Range("K3:p3")
For i = 1 To dongCuoi
  b(i, 1) = Left(a(i), 1)
  b(i, 2) = Val(Right(a(i), Len(a(i))-1)
  b(i, 3) = Application.VLookup(b(i, 2), bangDo, Application.Match(b(i, 1), bangLoai, 0), 1)
Next i
Range("G2:I2").Resize(dongCuoi, ).Value = b
Nhấp chuột vào đây để mở rộng...

Dạ, Thầy hướng dẫn giúp em dòng code sau ạ. Em không hiểu nguyên nhân tại sao lại Transpose ạ? Em có đổi lại nếu không Transpose
a = Sheet1.Range("D2:D" & dongCuoi) sẽ báo lỗi ở dòng b(i, 1) = Left(a(i), 1)
Nhưng khi Thầy để a = Application.Transpose(Range("D2:D" & dongCuoi).Value) thì kết quả ra đúng ạ.

Và em không hiểu chỗ a(i) có phải là mảng 1 chiều không ạ?
Thầy giải thích giúp em ạ. Em cảm ơn Thầy ạ.
 
Lần chỉnh sửa cuối:
Upvote 0
thao nguyen01 đã viết:
Dạ, em cảm ơn Thầy nhiều ạ. Em chạy code báo là lỗi Type Mismatch ạ. Em bấm Debug thì lỗi dòng For c = cMin To sArr(i, 2) ạ.
Bài đã được tự động gộp:



Dạ, code con viết chưa nạp đủ key ạ. Con hiểu nguyên nhân rồi ạ. Con cảm ơn Bác ạ.
Bài đã được tự động gộp:



Dạ, Thầy hướng dẫn giúp em dòng code sau ạ. Em không hiểu nguyên nhân tại sao lại Transpose ạ? Em có đổi lại nếu không Transpose
a = Sheet1.Range("D2:D" & dongCuoi) sẽ báo lỗi ở dòng b(i, 1) = Left(a(i), 1)
Nhưng khi Thầy để a = Application.Transpose(Range("D2:D" & dongCuoi).Value) thì kết quả ra đúng ạ. Thầy giải thích giúp em ạ. Em cảm ơn Thầy ạ.
Nhấp chuột vào đây để mở rộng...
Nhầm vùng dữ liệu
Mã: 
Sub dotim()
  Dim i As Long
  Dim sArr(), Res(), Dic As Object
 
  Set Dic = CreateObject("scripting.dictionary")
  Call CreateDic(Dic)
  sArr = Sheet1.Range("D2:D" & Sheet1.Range("D10000").End(xlUp).Row).Value
  ReDim Res(1 To UBound(sArr, 1), 1 To 1)
  For i = 1 To UBound(sArr, 1)
    Res(i, 1) = Dic.Item(sArr(i, 1))
  Next
  Sheet1.Range("I2:I1000").ClearContents
  Sheet1.Range("I2").Resize(UBound(sArr, 1)) = Res
End Sub

Sub CreateDic(Dic)
  Dim i As Long, j As Long, c As Long, cMin&
  Dim sArr()
 
  sArr = Sheet1.Range("K3:P" & Sheet1.Range("K10000").End(xlUp).Row).Value
  For i = 2 To UBound(sArr, 1)
    For c = cMin To sArr(i, 2)
      For j = 3 To 6
        Dic.Item(sArr(1, j) & c) = sArr(i, j)
      Next j
    Next c
    cMin = sArr(i, 2) + 1
  Next i
End Sub
 
Upvote 0
HieuCD đã viết:
Nhầm vùng dữ liệu
Mã: 
Sub dotim()
  Dim i As Long
  Dim sArr(), Res(), Dic As Object

  Set Dic = CreateObject("scripting.dictionary")
  Call CreateDic(Dic)
  sArr = Sheet1.Range("D2:D" & Sheet1.Range("D10000").End(xlUp).Row).Value
  ReDim Res(1 To UBound(sArr, 1), 1 To 1)
  For i = 1 To UBound(sArr, 1)
    Res(i, 1) = Dic.Item(sArr(i, 1))
  Next
  Sheet1.Range("I2:I1000").ClearContents
  Sheet1.Range("I2").Resize(UBound(sArr, 1)) = Res
End Sub

Sub CreateDic(Dic)
  Dim i As Long, j As Long, c As Long, cMin&
  Dim sArr()

  sArr = Sheet1.Range("K3:P" & Sheet1.Range("K10000").End(xlUp).Row).Value
  For i = 2 To UBound(sArr, 1)
    For c = cMin To sArr(i, 2)
      For j = 3 To 6
        Dic.Item(sArr(1, j) & c) = sArr(i, j)
      Next j
    Next c
    cMin = sArr(i, 2) + 1
  Next i
End Sub
Nhấp chuột vào đây để mở rộng...

Dạ, em cảm ơn Thầy ạ.
 
Upvote 0
thao nguyen01 đã viết:
...
Dạ, Thầy hướng dẫn giúp em dòng code sau ạ. Em không hiểu nguyên nhân tại sao lại Transpose ạ? Em có đổi lại nếu không Transpose
a = Sheet1.Range("D2:D" & dongCuoi) sẽ báo lỗi ở dòng b(i, 1) = Left(a(i), 1)
Nhưng khi Thầy để a = Application.Transpose(Range("D2:D" & dongCuoi).Value) thì kết quả ra đúng ạ.

Và em không hiểu chỗ a(i) có phải là mảng 1 chiều không ạ?
Thầy giải thích giúp em ạ. Em cảm ơn Thầy ạ.
Nhấp chuột vào đây để mở rộng...
Hàm transpose là một xảo thuật để đọc một cột trong bảng tính vào mảng 1 chiều.
Vì là xảo thuật cho nên tuy hiệu quả tốt, nó vẫn có những giới hạn của nó (vd khó làm việc với dữ liệu lớn, không đồng nhất,...) Nhưng ở đây dữ liệu tương đối ổn cho nên dùng tốt.
Lưu ý à ở trên tôi dùng từ "cột trong bảng tính". Nếu dòng thì phải dùng hai lần Transpose.
 
Upvote 0
VetMini đã viết:
Hàm transpose là một xảo thuật để đọc một cột trong bảng tính vào mảng 1 chiều.
Vì là xảo thuật cho nên tuy hiệu quả tốt, nó vẫn có những giới hạn của nó (vd khó làm việc với dữ liệu lớn, không đồng nhất,...) Nhưng ở đây dữ liệu tương đối ổn cho nên dùng tốt.
Lưu ý à ở trên tôi dùng từ "cột trong bảng tính". Nếu dòng thì phải dùng hai lần Transpose.
Nhấp chuột vào đây để mở rộng...

Dạ, em cảm ơn Thầy ạ. Em còn vướng một chỗ là khi đưa vào mảng một chiều a(i), phần tử đầu tiên trong mảng một chiều sẽ i=0 sẽ là ô D2, nhưng khi em chạy code For i = 1 To dongCuoi (i bắt đầu từ 1 thì a(1)=A1 (tức ô D2 ạ). Em chưa hiểu chỗ này ạ
 
Upvote 0
thao nguyen01 đã viết:
Dạ, em cảm ơn Thầy ạ. Em còn vướng một chỗ là khi đưa vào mảng một chiều a(i), phần tử đầu tiên trong mảng một chiều sẽ i=0 sẽ là ô D2, nhưng khi em chạy code For i = 1 To dongCuoi (i bắt đầu từ 1 thì a(1)=A1 (tức ô D2 ạ). Em chưa hiểu chỗ này ạ
Nhấp chuột vào đây để mở rộng...
Bạn có chắc phần tử đầu tiên là 1 không? Nếu chắc chắn thì nêu ví dụ để tôi xét lại.
Theo tôi hiểu thì tất cả hàm bảng tính đều mặc định phần tử đầu tiên là 1. Tất cả hàm VBA đều mặc định phần tử đầu tiên là 0 (trừ một số hàm có thể chịu ảnh hưởng bởi Option Base...).
Nên phân biệt thế nào là hàm bảng tính và hàm VBA.
 
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

C
Xin công thức xếp loại có điều kiện.
Trả lời
1
Đọc
34
Hoàng Trọng Nghĩa
Hoàng Trọng Nghĩa
8
  • Question
Xin giúp: Nhóm (group data) các dòng trong bảng tính
Trả lời
12
Đọc
441
ptm0412
ptm0412
hongquan93vn
Tìm công thức có thể đánh STT của giá trị mỗi lần xuất hiện
2
Trả lời
28
Đọc
533
ptm0412
ptm0412
T
  • Đã khóa
Tìm một bạn có kinh nghiệm về Excel
Trả lời
0
Đọc
45
tinhnhi1202
T
H
  • Question
Code VBA cộng tổng trên bảng CĐKT
Trả lời
4
Đọc
111
vak1590
vak1590
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