Chia sẻ cho mọi người một code xem trước kết quả trong cửa sổ Immediate
Code sẽ giúp các bạn có thể xem trước kết quả của một mảng nhanh hơn. Không cần phải Active Workbook mỗi lần chạy code mà có thể xem kết quả ngay trong cửa sổ lập trình VBA.
Bản Cập nhật mới: 24/11/2018 18:00
Sử dụng:
- Với mảng:
dbPrint [im, arrayHeader ,punc , reTypeArray2D, widthMinCol, widthMaxCol , puncMain, puncType,TypeMaxCol]
- Với các đối tượng đơn: số, chuỗi, double, variant,... :
dbPrint<..> thay cho: Debug.Print <..> (mỗi lần kiểm thử mà đánh chữ "debug" lại còn "." rồi "print")
1. [im] - Đối tượng để in ( hãy thử nhập vào bất kì đối tượng nào)
2. [arrayHeader] - mảng có /không tiêu đề
3. [punc] - thêm ký tự đứng trước ("" thì tự động đánh thứ tự)
4. [reTypeArray2D] - trả về / không trả về Type trong mảng 2D
5. [widthMinCol ] - giới hạn độ rộng nhỏ nhất
6. [widthMaxCol ] - giới hạn độ rộng của chuỗi dài nhất trong cột của mảng
7. [puncMain] - Màu mè hoa lá cành (Thử "<>") (cột có dữ liệu ngắn dài khác nhau mới thấy nhé)
8. [puncType] - dấu phân cách trước Type
9. [TypeMaxCol ] - Độ rộng cho Type
Bản hiện tại:
Dự kiến bản tiếp theo:
- In ra Đầu đề Column của vùng tham chiếu
Code sẽ giúp các bạn có thể xem trước kết quả của một mảng nhanh hơn. Không cần phải Active Workbook mỗi lần chạy code mà có thể xem kết quả ngay trong cửa sổ lập trình VBA.
Bản Cập nhật mới: 24/11/2018 18:00
Sử dụng:
- Với mảng:
dbPrint [im, arrayHeader ,punc , reTypeArray2D, widthMinCol, widthMaxCol , puncMain, puncType,TypeMaxCol]
- Với các đối tượng đơn: số, chuỗi, double, variant,... :
dbPrint<..> thay cho: Debug.Print <..> (mỗi lần kiểm thử mà đánh chữ "debug" lại còn "." rồi "print")
1. [im] - Đối tượng để in ( hãy thử nhập vào bất kì đối tượng nào)
2. [arrayHeader] - mảng có /không tiêu đề
3. [punc] - thêm ký tự đứng trước ("" thì tự động đánh thứ tự)
4. [reTypeArray2D] - trả về / không trả về Type trong mảng 2D
5. [widthMinCol ] - giới hạn độ rộng nhỏ nhất
6. [widthMaxCol ] - giới hạn độ rộng của chuỗi dài nhất trong cột của mảng
7. [puncMain] - Màu mè hoa lá cành (Thử "<>") (cột có dữ liệu ngắn dài khác nhau mới thấy nhé)
8. [puncType] - dấu phân cách trước Type
9. [TypeMaxCol ] - Độ rộng cho Type
Bản hiện tại:
Dự kiến bản tiếp theo:
- In ra Đầu đề Column của vùng tham chiếu
Mã:
Sub test_dbPrint()
Dim arr(), d2(2, 2) As Integer,arr2
Dim i As Integer, j As Integer, k As Integer
ReDim arr( 1 to 5, 1 to 5 )
For i = 1 To 5
For j = 1 To 5
arr(i, j) = "ABCDE"
Next j
Next
arr2 = Array(1.7, 2, "3", , 5, True, vbNewLine, 10000000, 1 / 2)
dbPrint arr, True, , True, , 7
dbPrint arr2, True, , True, , 7
End Sub
Function dbPrint(Optional ByVal im, _
Optional arrayHeader As Boolean = False, _
Optional punc As String = "", _
Optional reTypeArray2D As Boolean = False, _
Optional widthMinCol As Integer = 6, _
Optional widthMaxCol As Integer = 25, _
Optional puncMain As String = " ", _
Optional puncType As String = ".", _
Optional typeMaxCol As Integer = 10)
viewImmediate
If caption Then arrayHeader = False
If widthMinCol >= widthMaxCol Then Debug.Print "Set: widthMinCol < widthMaxCol": Exit Function
If IsMissing(im) Then Debug.Print "<Missing>": Exit Function
Dim cell As Variant, ubIM As Long, i As Long: i = 0:
Dim m As Integer, mHeader As String, nHeader As String, n As Integer, jString As String, reTypeStr As String
Dim topPrint As Boolean, strPrint As String, strBorder As String: topPrint = False
Dim lArr() As Variant, puncW As String, puncH As String, overCol As Boolean: overCol = False
puncW = " |": puncH = "|"
If IsArray(im) Then
If IsObject(im) Then
'Update sau
End If
Debug.Print VBA.String(1, vbNewLine)
If bool_array2d(im) Then
Dim imLBound As Long, imUBound As Long, imLBound2 As Long, imUBound2 As Long
imLBound = LBound(im): imLBound2 = LBound(im, 2): imUBound = UBound(im): imUBound2 = UBound(im, 2)
ReDim lArr(imLBound2 To imUBound2)
For n = imLBound2 To imUBound2
lArr(n) = widthMinCol
Next n
For m = imLBound To imUBound
For n = imLBound2 To imUBound2
If Len(im(m, n)) > lArr(n) Then lArr(n) = Len(im(m, n))
If lArr(n) > widthMaxCol Then lArr(n) = widthMaxCol
Next n
Next m
For m = imLBound To imUBound
If punc = vbNullString Then
mHeader = addCharStrL(m + arrayHeader, " ", "", "|", 3)
nHeader = addCharStrL(, " ", "", "+", 3)
If m = imLBound And arrayHeader Then mHeader = addCharStrL(, " ", "", "|", 3): _
nHeader = addCharStrL(, " ", "", "+", 3)
Else
mHeader = addCharStrL(punc, " ", "", "|", 3)
If m = imLBound Then nHeader = addCharStrL(punc, " ", "", "+", 3)
End If
jString = vbNullString
For n = imLBound2 To imUBound2
widthMaxCol = lArr(n)
If reTypeArray2D Then
puncW = ""
reTypeStr = addCharStrL(reType(im(m, n)), " ", IIf(Len(puncType) = 1, " " & puncType, Left(puncType, 1)), "|", typeMaxCol + 1)
If m = 1 And arrayHeader Then
reTypeStr = addCharStrL("Type", " ", IIf(Len(puncType) = 1, " " & puncType, Left(puncType, 1)), "|", typeMaxCol + 1)
End If
If Not topPrint Then
strBorder = strBorder & addCharStrL("", "-", , "+", widthMaxCol + 14)
End If
Else
If Not topPrint Then
strBorder = strBorder & addCharStrL("", "-", , "+", widthMaxCol + 2)
End If
End If
jString = jString & addCharStrL(im(m, n), puncMain, " ", puncW, widthMaxCol) & reTypeStr
Next n
If Not topPrint Then
Debug.Print addCharStrL("IsArray 2D ", "=", , , Len(strBorder) + 4) & vbNewLine & nHeader & strBorder
topPrint = True
End If
Debug.Print mHeader & jString
If Not overCol Then If Len(jString) > 1000 Then overCol = True
If m = 1 And arrayHeader Then
Debug.Print nHeader & strBorder
End If
Next m
Else
Debug.Print "IsArray 1D ========================================" & vbNewLine & _
"---------------------------------------------------"
On Error Resume Next
ubIM = UBound(im)
If err.Number <> 0 Then Debug.Print "Array Empty": Exit Function
For Each cell In im
cell = reStrConstants(cell)
If IsObject(cell) Then Debug.Print "Array contains object. Can't print !": Exit Function
If IsMissing(cell) Then cell = "<Missing!>"
i = i + 1
mHeader = i
If punc <> "" Then mHeader = punc
Debug.Print mHeader & vbTab & addCharStrL(cell, , , , widthMaxCol) & " -> " & reType(cell)
Next cell
End If
Debug.Print IIf(strBorder <> vbNullString, nHeader & strBorder, addCharStrL("", "-", , , 51)) & _
vbNewLine & addCharStrL("End Print ", "=", , , IIf(Len(strBorder) <> 0, Len(strBorder), 46) + 4)
If UBound(im) > 200 Or overCol Then: Debug.Print "*Warning: Immediate - limit the results - 200 rows / 1000 columns"
Else
Debug.Print vbCr & im & " -> " & reType(im)
End If
End Function
Sub test_reType()
dbPrint reType(1)
End Sub
Public Function reType(Optional ByVal im) As String
If IsMissing(im) Then reType = "<Missing>": Exit Function
If VarType(im) = vbArray Then
reType = "vbArray"
ElseIf VarType(im) = vbEmpty Then reType = "vbEmpty"
ElseIf VarType(im) = vbNull Then reType = "vbNull"
ElseIf VarType(im) = vbInteger Then reType = "vbInteger"
ElseIf VarType(im) = vbLong Then reType = "vbLong"
ElseIf VarType(im) = vbSingle Then reType = "vbSingle"
ElseIf VarType(im) = vbDouble Then reType = "vbDouble"
ElseIf VarType(im) = vbCurrency Then reType = "vbCurrency"
ElseIf VarType(im) = vbDate Then reType = "vbDate"
ElseIf VarType(im) = vbString Then
reType = "vbString"
If vbStrConstants(im) Then reType = "vbStrConstants"
ElseIf VarType(im) = vbObject Then reType = "vbObject"
ElseIf VarType(im) = vbError Then reType = "vbError"
ElseIf VarType(im) = vbBoolean Then reType = "vbBoolean"
ElseIf VarType(im) = vbVariant Then reType = "vbVariant"
ElseIf VarType(im) = vbDataObject Then reType = "vbDataObject"
ElseIf VarType(im) = vbDecimal Then reType = "vbDecimal"
ElseIf VarType(im) = vbByte Then reType = "vbByte"
ElseIf VarType(im) = vbUserDefinedType Then reType = "vbUserDefinedType"
ElseIf VarType(im) = vbLongLong Then reType = "vbLongLong"
Else
reType = im
End If
End Function
Sub test_vbStrConstants()
dbPrint vbStrConstants("vbEmpty")
End Sub
Public Function vbStrConstants(Optional ByVal im As Variant) As Boolean
If IsMissing(im) Then Exit Function
If im = vbEmpty Or im = vbCr Or im = vbCrLf _
Or im = vbFormFeed Or im = vbLf Or im = vbNewLine _
Or im = vbNullChar Or im = vbNullString Or im = vbTab Or im = vbVerticalTab _
Or im = "vbEmpty" Or im = "vbCr" Or im = "vbCrLf" _
Or im = "vbFormFeed" Or im = "vbLf" Or im = "vbNewLine" _
Or im = "vbNullChar" Or im = "vbNullString" Or im = "vbTab" Or im = "vbVerticalTab" Then _
vbStrConstants = True
End Function
Sub test_reStrConstants()
dbPrint reStrConstants(vbEmpty)
End Sub
Public Function reStrConstants(Optional ByVal im As Variant) As Variant
reStrConstants = im
If IsMissing(im) Then reStrConstants = "<Missing>": Exit Function
If im = vbEmpty Then reStrConstants = "vbVerticalTab"
If im = vbCr Then reStrConstants = "vbCr"
If im = vbCrLf Then reStrConstants = "vbCrLf"
If im = vbFormFeed Then reStrConstants = "vbFormFeed"
If im = vbLf Then reStrConstants = "vbLf"
If im = vbNewLine Then reStrConstants = "vbNewLine"
If im = vbNullChar Then reStrConstants = "vbNullChar"
If im = vbNullString Then reStrConstants = "vbNullString"
If im = vbTab Then reStrConstants = "vbTab"
If im = vbVerticalTab Then reStrConstants = "vbVerticalTab"
End Function
Sub test_addCharStrL()
Dim em As String
em = addCharStrL("a", "->", "-", "|", 30, 1)
Debug.Print em & " len: " & Len(em)
End Sub
Function addCharStrL(Optional ByVal strL As Variant = "", _
Optional ByVal MainChar As Variant = " ", _
Optional ByVal charL As Variant = "", _
Optional ByVal charR As Variant = "", _
Optional ByVal limitStr As Integer = 25, _
Optional ByVal loopStr As Long = 1) As String
Dim i As Integer, j As Integer, char_L As String, char_R As String, reStr As String, Char As String
Dim lenL As Integer: lenL = Len(strL)
If lenL > limitStr Then strL = Left(strL, limitStr - 2) & ".."
Char = newStrChar(MainChar, limitStr - Len(strL), Len(strL))
reStr = charL & strL & Char & charR
For i = 1 To loopStr
addCharStrL = addCharStrL & reStr
Next
End Function
Sub test_newStrChar()
Dim em As String
em = newStrChar("->", 45, Len("helloa"))
Debug.Print em & " len: " & Len(em)
End Sub
Function newStrChar(Optional ByVal strChar As Variant = " ", _
Optional ByVal limitChar As Integer, _
Optional ByVal LStart As Integer)
If limitChar <= 0 Then newStrChar = "": Exit Function
Dim i As Integer, m As Integer, n As Integer, k As Integer, arr() As Variant
k = Len(strChar): m = 0: n = 0
ReDim arr(limitChar - 1)
Do
For i = 1 To k
If m >= LStart Then: arr(n) = Mid(strChar, i, 1): n = n + 1
m = m + 1
If n = limitChar Then GoTo Result
Next i
Loop While True
Result: newStrChar = Join(arr, "")
End Function
Function bool_array2d(arr As Variant) As Boolean
Dim i As Long
On Error Resume Next
i = LBound(arr, 2)
bool_array2d = Err = 0
End Function
Sub viewImmediate()
On Error Resume Next
Application.VBE.Windows("Immediate").Visible = True
End Sub
