Chuyên mục xử lý, gỡ rối code VBA

ndu96081631 · 24/9/13

Topic Những câu hỏi về code, xin giải thích các code... đã quá dài nên mình đóng nó lại và mở topic khác
Tất cả những bài viết liên quan đến việc nhờ giải thích, xử lý và gỡ rối code VBA, các bạn vui lòng đăng tại đây!
Cảm ơn

befaint · 3/5/18

huongmuine đã viết:
Nhờ anh chị chỉ giúp: chỉnh lại như thể nào để:
khi sArr(I, 19) = Empty thì dArr(I, 8) điền "/".

Mã:

If sArr(I, 19) <> Empty Then
        If Month(sArr(I, 19)) < 8 Then
            dArr(I, 8) = Right(sArr(I, 19), 2) - 1 & Right(sArr(I, 19), 2)
        ElseIf sArr(I, 19) > 8 Then
            dArr(I, 8) = Right(sArr(I, 19), 2) & Right(sArr(I, 19), 2) + 1
        Else
            dArr(I, 8) = "/"
        End If
Else
dArr(I, 8) = "/"
End If

huongmuine · 3/5/18

befaint đã viết:

Mã:

If sArr(I, 19) <> Empty Then
        If Month(sArr(I, 19)) < 8 Then
            dArr(I, 8) = Right(sArr(I, 19), 2) - 1 & Right(sArr(I, 19), 2)
        ElseIf sArr(I, 19) > 8 Then
            dArr(I, 8) = Right(sArr(I, 19), 2) & Right(sArr(I, 19), 2) + 1
        Else
            dArr(I, 8) = "/"
        End If
Else
dArr(I, 8) = "/"
End If

Có thể giải thích giúp mình vì sao phải thêm một lần nữa:
Else
dArr(I, 8) = "/"
Xin cảm ơn befaint.

cobala137 · 3/5/18

Em xin phép xóa post vì đăng nhầm chỗ. em cảm ơn.

befaint · 3/5/18

huongmuine đã viết:
vì sao phải thêm một lần nữa:
Else
dArr(I, 8) = "/"

Mã:

If sArr(I, 19) <> Empty Then
'Nếu sArr(I, 19) khác "Empty" thì abc
'Khúc If ... ElseIf ... Else...End IF dưới này là cái abc đó
        If Month(sArr(I, 19)) < 8 Then
            dArr(I, 8) = Right(sArr(I, 19), 2) - 1 & Right(sArr(I, 19), 2)
        ElseIf sArr(I, 19) > 8 Then
            dArr(I, 8) = Right(sArr(I, 19), 2) & Right(sArr(I, 19), 2) + 1
        Else
            dArr(I, 8) = "/"
        End If
Else
'Ngược lại (Tức là sArr(I, 19) = "Empty" thì xyz
' dArr(I, 8) = "/" là cái xyz đó
dArr(I, 8) = "/"
End If

huongmuine · 3/5/18

befaint đã viết:

Mã:

If sArr(I, 19) <> Empty Then
'Nếu sArr(I, 19) khác "Empty" thì abc
'Khúc If ... ElseIf ... Else...End IF dưới này là cái abc đó
        If Month(sArr(I, 19)) < 8 Then
            dArr(I, 8) = Right(sArr(I, 19), 2) - 1 & Right(sArr(I, 19), 2)
        ElseIf sArr(I, 19) > 8 Then
            dArr(I, 8) = Right(sArr(I, 19), 2) & Right(sArr(I, 19), 2) + 1
        Else
            dArr(I, 8) = "/"
        End If
Else
'Ngược lại (Tức là sArr(I, 19) = "Empty" thì xyz
' dArr(I, 8) = "/" là cái xyz đó
dArr(I, 8) = "/"
End If

Rất cảm ơn befaint giải thích để mình hiểu hơn.
Chúc befaint nhiều niềm vui trong thời gian còn lại của ngày.

vova2209 · 3/5/18

HieuCD đã viết:

Mình nhớ nhầm

Mã:

Sub SetupRowBangKL2()
Dim i As Long, n As Byte, hArr(), sArr()
  sArr = Array("Sheet24", "Sheet25")
  ReDim hArr(1 To 11)
  For i = 1 To 11
     hArr(i) = Sheet23.Range("B" & i).RowHeight
  Next i
  For n = 0 To UBound(sArr)
    For i = 1 To 11
        Sheets(sArr(n)).Range("B" & i).RowHeight = hArr(i)
    Next i
  Next n
End Sub

Bị lỗi code này a à! hay là do sai tên nhỉ. Sheet24(aaaa), Sheet25(bbbb) sheet24 chứ không phải tên sheets đó là aaaa
Anh xem lại dùm em
Sheets(sArr(n).Range("B" & i).RowHeight = hArr(i)

HieuCD · 3/5/18

vova2209 đã viết:
Bị lỗi code này a à! hay là do sai tên nhỉ. Sheet24(aaaa), Sheet25(bbbb) sheet24 chứ không phải tên sheets đó là aaaa
Anh xem lại dùm em
Sheets(sArr(n).Range("B" & i).RowHeight = hArr(i)

Sheet24(aaaa), Sheet25(bbbb) ở đâu ra vậy?

vova2209 · 3/5/18

HieuCD đã viết:
Sheet24(aaaa), Sheet25(bbbb) ở đâu ra vậy?

ý em là muốn lấy cái tên sheet phần mầu đỏ chữ không phải phần bôi xanh, vì có thể mình sẽ sửa tên sheet đó không ảnh hưởng đến code

HieuCD · 3/5/18

vova2209 đã viết:
View attachment 194856
ý em là muốn lấy cái tên sheet phần mầu đỏ chữ không phải phần bôi xanh, vì có thể mình sẽ sửa tên sheet đó không ảnh hưởng đến code

Quên ý tưởng đó đi bạn, dùng vòng lặp chỉ lấy tên sheet hoặc thứ tự sheet

vova2209 · 3/5/18

HieuCD đã viết:
Quên ý tưởng đó đi bạn, dùng vòng lặp chỉ lấy tên sheet hoặc thứ tự sheet

Vâng em cảm ơn anh! có ít sheets dùng cách trên cũng được ạ

HieuCD · 3/5/18

vova2209 đã viết:
View attachment 194856
ý em là muốn lấy cái tên sheet phần mầu đỏ chữ không phải phần bôi xanh, vì có thể mình sẽ sửa tên sheet đó không ảnh hưởng đến code

Chạy thử code

Mã:

Sub SetupRowBangKL2()
Dim i As Long, n As Byte, hArr(), sArr()
  sArr = Array(Sheet24, Sheet25)
  ReDim hArr(1 To 11)
  For i = 1 To 11
     hArr(i) = Sheet23.Range("B" & i).RowHeight
  Next i
  For n = 0 To UBound(sArr)
    For i = 1 To 11
        Sheets(sArr(n)).Range("B" & i).RowHeight = hArr(i)
    Next i
  Next n
End Sub

befaint · 3/5/18

vova2209 đã viết:
View attachment 194856
ý em là muốn lấy cái tên sheet phần mầu đỏ chữ không phải phần bôi xanh, vì có thể mình sẽ sửa tên sheet đó không ảnh hưởng đến code

Cái đó gọi là CodeName... Lần trước mấy người chỉ cho tận nơi có tài liệu cần đọc rồi. Lâu lâu mình quay lại và vẫn hỏi lợi hại / hồn nhiên như xưa.

Cách gọi worksheet thông qua biến gán chuỗi là CodeName của nó hình như trên diễn đàn cũng có rồi thì phải...
Có thể thử cách sau:

PHP:

Function SheetCodeName(ByVal sCodeName As String, Optional wb As Workbook) As Worksheet
    If wb Is Nothing Then Set wb = ThisWorkbook
    Set SheetCodeName = wb.Sheets(wb.VBProject.VBComponents(sCodeName).Properties("Index"))
End Function
'=============='
Sub vidu()
    Dim aCodeName, ws As Worksheet, sName
    aCodeName = Array("Sheet1", "Sheet2") 'Liệt kê codeName của các sheets '
    For Each sName In aCodeName
        Set ws = SheetCodeName(sName)
        ws.Select
    Next sName
End Sub

vova2209 · 3/5/18

befaint đã viết:
Cái đó gọi là CodeName... Lần trước mấy người chỉ cho tận nơi có tài liệu cần đọc rồi. Lâu lâu mình quay lại và vẫn hỏi lợi hại / hồn nhiên như xưa.

Cách gọi worksheet thông qua biến gán chuỗi là CodeName của nó hình như trên diễn đàn cũng có rồi thì phải...
Có thể thử cách sau:

PHP:

Function SheetCodeName(ByVal sCodeName As String, Optional wb As Workbook) As Worksheet If wb Is Nothing Then Set wb = ThisWorkbook Set SheetCodeName = wb.Sheets(wb.VBProject.VBComponents(sCodeName).Properties("Index")) End Function '==============' Sub vidu() Dim aCodeName, ws As Worksheet, sName aCodeName = Array("Sheet1", "Sheet2") 'Liệt kê codeName của các sheets ' For Each sName In aCodeName Set ws = SheetCodeName(sName) ws.Select Next sName End Sub

Cảm ơn anh HiếuCD và anh Befant em ngồi nghiên cứu chút mắc chỗ nào lại phiền các anh

vova2209 · 4/5/18

[QUOTE="HieuCD[/QUOTE]
[QUOTE="Befait[/QUOTE]
Cảm ơn các anh đã giúp đỡ.. nhìn chạy chạy từng dòng trông đẹp mắt thật ^^!

Mã:

Sub TieuDeRowBangKL()
    Dim i As Long
    Dim aCodeName, ws As Worksheet, sName
        aCodeName = Array("Sheet24", "Sheet25", "Sheet26", "Sheet39", "Sheet40", "Sheet111") 'Liêt kê codeName cua các sheets
  
    On Error Resume Next
    For Each sName In aCodeName
        Set ws = SheetCodeName(sName)
        For i = 1 To 11
        ws.Select
            ws.Range("B" & i).RowHeight = Sheet23.Range("B" & i).RowHeight
        Next i
    Next sName
End Sub

Đây là code cũ của em trông gà thật ^^!

Mã:

Sub SetupRowBangKL2()
Dim i As Long
    For i = 1 To 11
        Sheet24.Range("B" & i).RowHeight = Sheet23.Range("B" & i).RowHeight
        Sheet25.Range("B" & i).RowHeight = Sheet23.Range("B" & i).RowHeight
        Sheet26.Range("B" & i).RowHeight = Sheet23.Range("B" & i).RowHeight
        Sheet39.Range("B" & i).RowHeight = Sheet23.Range("B" & i).RowHeight
        Sheet40.Range("B" & i).RowHeight = Sheet23.Range("B" & i).RowHeight
    Next i
End Sub

VetMini · 4/5/18

Code mới vẫn còn lủng củng lắm.

vova2209 · 4/5/18

VetMini đã viết:
Code mới vẫn còn lủng củng lắm.

Mã:

Sub TieuDeRowBangKL()
    Dim i As Long
    Dim aCodeName, ws As Worksheet, sName
        aCodeName = Array("Sheet24", "Sheet25", "Sheet26", "Sheet39", "Sheet40", "Sheet111") 'Liêt kê codeName cua các sheets
 
    On Error Resume Next
    For Each sName In aCodeName
        Set ws = SheetCodeName(sName)
        For i = 1 To 11
        ws.Select
            ws.Range("B" & i).RowHeight = Sheet23.Range("B" & i).RowHeight
        Next i
    Next sName
End Sub

Cho em hỏi sao code lấy CodeName để chạy khi đặt mật khẩu VBA thì code ko chạy, cho đến khi đánh mật khẩu vào mở ra thì nó mới chạy.
Code mới rút gọn lại hơn hay như nào chị tư vấn cho em với ạ

VetMini · 4/5/18

Điển hình: ws.Select 11 lần

Chú: nếu có thói quen dùng "On Error..." thì phải nhớ lệnh này đi cặp. Qua đoạn cần thiết thì "On Error Goto 0"

vova2209 · 4/5/18

VetMini đã viết:
Điển hình: ws.Select 11 lần

Chú: nếu có thói quen dùng "On Error..." thì phải nhớ lệnh này đi cặp. Qua đoạn cần thiết thì "On Error Goto 0"

"On Error Goto 0" cái này giống như debug à Chị!
ws.Select 11 lần: đúng rồi phải để lên trên dưới For each. Cái ws.Select em để chuyển sang nhìn từng sheet cho đẹp mắt ^^!

VetMini · 4/5/18

vova2209 đã viết:
"On Error Goto 0" cái này giống như debug à Chị!
...

Bó tay.

vova2209 đã viết:
...
Cái ws.Select em để chuyển sang nhìn từng sheet cho đẹp mắt ^^!

Lại bó tay. Đáng lẽ chỉ cần select 1 lần rồi làm luôn một loạt. Nhưng mà đã muốn làm mầu mè thì thôi, tôi không cần phải chỉ cách gọn gàng.

vova2209 · 4/5/18

VetMini đã viết:
Bó tay.

Lại bó tay. Đáng lẽ chỉ cần select 1 lần rồi làm luôn một loạt. Nhưng mà đã muốn làm mầu mè thì thôi, tôi không cần phải chỉ cách gọn gàng.

^^! để em tìm trong diễn đàn tìm hiểu lại. Em cảm ơn ạ

Chuyên mục xử lý, gỡ rối code VBA

Huyền thoại GPE

|||||||||||||

Thành viên GPE

Thành viên mới

|||||||||||||

Thành viên GPE

Thành viên tích cực

Chuyên gia GPE

Thành viên tích cực

Chuyên gia GPE

Thành viên tích cực

Chuyên gia GPE

|||||||||||||

Thành viên tích cực

Thành viên tích cực

Ăn cùng góc phố

Thành viên tích cực

Ăn cùng góc phố

Thành viên tích cực

Ăn cùng góc phố

Thành viên tích cực

Facebook

Group