- Tham gia
- 17/8/08
- Bài viết
- 8,662
- Được thích
- 16,718
- Giới tính
- Nam
Nhân dịp có bài viết:
Tôi viết một hàm tìm ID còn sót trong dãy thứ tự của cột ID, hàm đơn giản, không cần dùng Dictionary các bạn tham khảo nhé.
Khuyến mãi thêm hàm nhận biết mảng có bao nhiêu chiều:
Khi tôi viết hàm này tôi đã lường trước nhiều kiểu dữ liệu nhập vào nên nó khá tổng quát, ngoại trừ mảng xuất ra từ ADO (GetRows) vì nó ngược ngược với mảng từ Range của Excel, nhưng nếu chép mảng đó vào Excel thì xử lý vô tư.
Với file tôi đính kèm, đọc kỹ hướng dẫn trước khi sử dụng.
Tạo mã hàng hóa cho hàng hóa mới! Nhờ ACE giúp mình!
mã hàng: 2 chữ cái đầu của tên hàng (không dấu, ký tự đặc biệt) + 3 số mà em có danh sách một số mã hàng có sẵn rồi ạ. Có cách nào xài hàm VBA để nó tự xuất ra mã hàng mà không trùng với những mã hàng hiện tại không ạ? Xin được mọi người giúp đỡ ạ! Em xin cám ơn nhiều!
www.giaiphapexcel.com
Tôi viết một hàm tìm ID còn sót trong dãy thứ tự của cột ID, hàm đơn giản, không cần dùng Dictionary các bạn tham khảo nhé.
Mã:
Function FindShortageID(ByVal rngSource, ByVal strChuoiKyTu As String, Optional ByVal bytKySo As Byte = 1) As Variant
Dim bytLen As Byte
Dim arrResult, arrSource, arrTemp(), arrTemple()
Dim lngIDNum As Long, c As Long, i As Long, k As Long, n As Long, r As Long, lbd As Long, lbd2 As Long, ubd As Long
bytLen = Len(strChuoiKyTu)
If IsNumeric(rngSource) Or TypeName(rngSource) = "String" Then
ReDim arrSource(1 To 1, 1 To 1)
arrSource(1, 1) = rngSource
ElseIf TypeName(rngSource) = "Range" Then
If rngSource.Rows.Count = 1 And rngSource.Columns.Count = 1 Then
ReDim arrSource(1 To 1, 1 To 1)
arrSource(1, 1) = rngSource.Value
Else
arrSource = rngSource.Value
End If
ElseIf IsArray(rngSource) Then
If GetArrDimensions(rngSource) = 1 Then
arrSource = WorksheetFunction.Transpose(rngSource)
Else
arrSource = rngSource
End If
End If
lbd = LBound(arrSource, 1): lbd2 = LBound(arrSource, 2)
ubd = UBound(arrSource, 1)
For i = lbd To ubd
If Left(arrSource(i, lbd2), bytLen) = strChuoiKyTu Then
n = n + 1
ReDim Preserve arrTemp(1 To n)
arrTemp(n) = Abs(Val(Replace(arrSource(i, lbd2), strChuoiKyTu, "")))
End If
Next
If n Then
ubd = WorksheetFunction.Max(arrTemp)
For r = 1 To ubd
For c = 1 To n
If arrTemp(c) = r Then
GoTo NextNum
End If
Next
k = k + 1
ReDim Preserve arrTemple(1 To k)
arrTemple(k) = strChuoiKyTu & Format(r, String(bytKySo, "0"))
NextNum:
Next
If k Then
ReDim arrResult(1 To k + 1, 1 To 1)
For r = 1 To k
arrResult(r, 1) = arrTemple(r)
Next
arrResult(r, 1) = strChuoiKyTu & Format(ubd + 1, String(bytKySo, "0"))
Else
ReDim arrResult(1 To 1, 1 To 1)
arrResult(1, 1) = strChuoiKyTu & Format(ubd + 1, String(bytKySo, "0"))
End If
Else
ReDim arrResult(1 To 1, 1 To 1)
arrResult(1, 1) = strChuoiKyTu & Format(1, String(bytKySo, "0"))
End If
FindShortageID = arrResult
End Function
Khuyến mãi thêm hàm nhận biết mảng có bao nhiêu chiều:
Mã:
Function GetArrDimensions(arrVariant) As Long
Dim c As Long, n As Long
On Error GoTo Result
Do
c = c + 1
n = LBound(arrVariant, c)
Loop
Result:
GetArrDimensions = c - 1
End Function
Khi tôi viết hàm này tôi đã lường trước nhiều kiểu dữ liệu nhập vào nên nó khá tổng quát, ngoại trừ mảng xuất ra từ ADO (GetRows) vì nó ngược ngược với mảng từ Range của Excel, nhưng nếu chép mảng đó vào Excel thì xử lý vô tư.
Với file tôi đính kèm, đọc kỹ hướng dẫn trước khi sử dụng.
HƯỚNG DẪN SỬ DỤNG |
1) Copy cột ID được cho là thiếu số thứ tự liên tục vào cột A |
2) Điền vào ô F2 chuỗi tương ứng |
3) Điền vào ô G2 số lượng ký số định dạng (VD: 001 là 3, 0001 là 4, 000001 là 6,…) |
4) Bấm nút sẽ ra kết quả, hàm trả về dãy ID còn thiếu và 01 ID mới. |
5) Kết quả nó sẽ sắp xếp ID từ nhỏ đến lớn cho bạn mặc dù cột A có lộn xộn. |
File đính kèm
Lần chỉnh sửa cuối: