Chuyên mục xử lý, gỡ rối code VBA (1 người xem)

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

truelove0310 · 26/4/18

HieuCD đã viết:
Bạn dùng thử hàm Union(Range1,Range2,Range3,...)

Oh. đúng là mừ chữ có khác. mò hoài không ra
Cảm ơn bản đã chỉ nhé. Ok rồi!

batman1 · 26/4/18

truelove0310 đã viết:
điều kiện duyệt là giá trị "0" đó bạn.
Mình có 1 bảng có các ô [a6:a10] và [c26:c36] có giá trị độc lập. giờ mình muốn ô nào có giá trị "0" thì ẩn đi ô nào có giá trị thì hiện ra.

Nếu tôi hiểu ý thì

Mã:

Private Sub Worksheet_Activate()

    Dim Rng As Range, resRng As Range

    Application.ScreenUpdating = False
    Range("a6:a10, c26:c36").EntireRow.Hidden = False
 
    For Each Rng In Range("a6:a10, c26:c36")
        If Rng.Value = 0 Then
            If resRng Is Nothing Then
                Set resRng = Rng
            Else
                Set resRng = Union(resRng, Rng)
            End If
        End If
    Next Rng
    If Not resRng Is Nothing Then resRng.EntireRow.Hidden = True
End Sub

Thậm chí nếu bạn chỉ có 1 khoảng trong 1 cột nhưng là hàng nghìn dòng thì cũng nên dùng UNION như trên. Ngược lại có thể chờ mỏi mắt mới thấy cập nhật.

Tức không UNION "a6:a10" và "c26:c36" mà ý tôi nói về UNION khác. Nếu dư liệu nhiều thì tuyệt đối cấm ẩn / hiện từng dòng. Vì ccó thể phải đi uống cà phê.

truelove0310 · 26/4/18

batman1 đã viết:
Nếu tôi hiểu ý thì

Mã:

Private Sub Worksheet_Activate() Dim Rng As Range, resRng As Range Application.ScreenUpdating = False Range("a6:a10, c26:c36").EntireRow.Hidden = False For Each Rng In Range("a6:a10, c26:c36") If Rng.Value = 0 Then If resRng Is Nothing Then Set resRng = Rng Else Set resRng = Union(resRng, Rng) End If End If Next Rng If Not resRng Is Nothing Then resRng.EntireRow.Hidden = True End Sub

Thậm chí nếu bạn chỉ có 1 khoảng trong 1 cột nhưng là hàng nghì dòng thì cũng nên dùng UNION như trên. Ngược lại có thể chờ mỏi mắt mới thấy cập nhật.

batman1 đã viết:
Nếu tôi hiểu ý thì

Mã:

Private Sub Worksheet_Activate() Dim Rng As Range, resRng As Range Application.ScreenUpdating = False Range("a6:a10, c26:c36").EntireRow.Hidden = False For Each Rng In Range("a6:a10, c26:c36") If Rng.Value = 0 Then If resRng Is Nothing Then Set resRng = Rng Else Set resRng = Union(resRng, Rng) End If End If Next Rng If Not resRng Is Nothing Then resRng.EntireRow.Hidden = True End Sub

Thậm chí nếu bạn chỉ có 1 khoảng trong 1 cột nhưng là hàng nghìn dòng thì cũng nên dùng UNION như trên. Ngược lại có thể chờ mỏi mắt mới thấy cập nhật.

Tức không UNION "a6:a10" và "c26:c36" mà ý tôi nói về UNION khác. Nếu dư liệu nhiều thì tuyệt đối cấm ẩn / hiện từng dòng. Vì ccó thể phải đi uống cà phê.

code của bạn khó dùng quá. với những người không hiểu về lập trình như tôi thì càng đơn giản càng dễ dùng bạn ạ! cảm ơn bạn nhiều nhé.

cuong.vp.nuce · 26/4/18

Đây là file mình làm:
Mình muốn lấy giá trị Sheet2.[B6] = Sheet1.[A3] thông qua giá trị Sheet1[C1] qua 1 nút lệnh.
Các bác có cách nào không,

batman1 · 26/4/18

truelove0310 đã viết:
code của bạn khó dùng quá. với những người không hiểu về lập trình như tôi thì càng đơn giản càng dễ dùng bạn ạ! cảm ơn bạn nhiều nhé.

Tôi viết trong chủ đề của bạn nhưng các bài viết trên GPE là cho cả những người khác, cho cả những người trong tương lai dùng công cụ tìm kiếm để có được cái họ cần. Nếu chỉ trả lời thớt thôi thì gửi vào e-mail chứ làm rác diễn đàn làm gì?
Những người khác có thể có nhiều dữ liệu hơn bạn và cách của bạn là phải đi uống cà phê. Vì tôi viết cho cả những người khác có cùng nhu cầu nên tôi viết khác và tôi lưu ý.

cuong.vp.nuce · 26/4/18

batman1 đã viết:
Tôi viết trong chủ đề của bạn nhưng các bài viết trên GPE là cho cả những người khác, cho cả những người trong tương lai dùng công cụ tìm kiếm để có được cái họ cần. Nếu chỉ trả lời thớt thôi thì gửi vào e-mail chứ làm rác diễn đàn làm gì?
Những người khác có thể có nhiều dữ liệu hơn bạn và cách của bạn là phải đi uống cà phê. Vì tôi viết cho cả những người khác có cùng nhu cầu nên tôi viết khác và tôi lưu ý.

Bạn ơi. Bạn có thể giúp mình file tesst trên kia ko bạn.

batman1 · 26/4/18

cuong.vp.nuce đã viết:
Bạn ơi. Bạn có thể giúp mình file tesst trên kia ko bạn.

Không hiểu ý lắm.
Nếu là như bạn viết thì công thức cho Sheet2!B6

Mã:

=Sheet1!A3

Trong Sheet1!C1 có công thức =B3. Dữ liệu chỉ có 1 dòng.
"B" là cố định, "3" là cố định?
Nếu không thì mô tả từ đầu, ý như thế nào.

themorzer · 1/5/18

Chào Thầy!
em cần giúp đỡ, em có đoạn code dưới, nhưng khi chạy thì khi gặp giá trị rỗng trong mãng nó xuất hiện 2 hộp thoại "data is empty"
cách giải quyết như thế nào vậy thầy, mong được sự giúp đỡ

Mã:

Function searchdk(ByVal ter As String, ByVal wire As String, hsArray)
Dim colP As Long
Dim rowP As Long
 colP = Sheet2.[A1].End(xlToRight).Column + 1
 rowP = Sheet2.[A1].End(xlDown).Row + 1
  Dim i As Long, j As Long, dk As String, TmpArr, TmpStr, Tmp, Arr
  TmpArr = hsArray
  For i = 1 To UBound(TmpArr)
     
     If TmpArr(i, 1) = ter Then
            For j = 1 To UBound(TmpArr, 2)
                    If TmpArr(1, j) = Empty And TmpArr(1, j) <> wire Then
                        MsgBox ("data is empty")
                        Sheet2.Cells(1, colP).Value = wire
                    Exit Function
           
                    ElseIf TmpArr(1, j) = wire Then
                        searchdk = TmpArr(i, j)
                    Exit Function
                    End If
               
     
            Next j
       
     End If
  Next i
 ' searchdk = Arr
End Function
[code]

themorzer · 1/5/18

themorzer đã viết:

Chào Thầy!
em cần giúp đỡ, em có đoạn code dưới, nhưng khi chạy thì khi gặp giá trị rỗng trong mãng nó xuất hiện 2 lần hộp thoại "data is empty" sau khi bấm OK
cách giải quyết như thế nào vậy thầy, mong được sự giúp đỡ

Mã:

Function searchdk(ByVal ter As String, ByVal wire As String, hsArray)
Dim colP As Long
Dim rowP As Long
colP = Sheet2.[A1].End(xlToRight).Column + 1
rowP = Sheet2.[A1].End(xlDown).Row + 1
  Dim i As Long, j As Long, dk As String, TmpArr, TmpStr, Tmp, Arr
  TmpArr = hsArray
  For i = 1 To UBound(TmpArr)
    
     If TmpArr(i, 1) = ter Then
            For j = 1 To UBound(TmpArr, 2)
                    If TmpArr(1, j) = Empty And TmpArr(1, j) <> wire Then
                        MsgBox ("data is empty")
                        Sheet2.Cells(1, colP).Value = wire
                    Exit Function
          
                    ElseIf TmpArr(1, j) = wire Then
                        searchdk = TmpArr(i, j)
                    Exit Function
                    End If
              
    
            Next j
      
     End If
  Next i
' searchdk = Arr
End Function
[code]

truongvu317 · 1/5/18

themorzer đã viết:

Chào Thầy!
em cần giúp đỡ, em có đoạn code dưới, nhưng khi chạy thì khi gặp giá trị rỗng trong mãng nó xuất hiện 2 hộp thoại "data is empty"
cách giải quyết như thế nào vậy thầy, mong được sự giúp đỡ

Mã:

Function searchdk(ByVal ter As String, ByVal wire As String, hsArray)
Dim colP As Long
Dim rowP As Long
colP = Sheet2.[A1].End(xlToRight).Column + 1
rowP = Sheet2.[A1].End(xlDown).Row + 1
  Dim i As Long, j As Long, dk As String, TmpArr, TmpStr, Tmp, Arr
  TmpArr = hsArray
  For i = 1 To UBound(TmpArr)
    
     If TmpArr(i, 1) = ter Then
            For j = 1 To UBound(TmpArr, 2)
                    If TmpArr(1, j) = Empty And TmpArr(1, j) <> wire Then
                        MsgBox ("data is empty")
                        Sheet2.Cells(1, colP).Value = wire
                    Exit Function
          
                    ElseIf TmpArr(1, j) = wire Then
                        searchdk = TmpArr(i, j)
                    Exit Function
                    End If
              
    
            Next j
      
     End If
  Next i
' searchdk = Arr
End Function
[code]

Tui chả hiểu bạn học vba ở đâu, chứ chả có ai viết function lại dùng mấy cái msgbox làm gì. function thì thường thì thực hiện tính toán thui, chứ không hiện thông báo làm gì. Lại còn thực hiện viết dữ liệu vào các sheet khác nữa, mặc dù nó vẫn có thể viết được dữ liệu, nhưng khi dùng trong excel thì lệnh đó sẽ vô tác dụng, thà nói mục đích là gì, người khác viết lại cho nhanh, mà chả có file thì ai dám giúp.

huongmuine · 2/5/18

Nhờ các anh chị sửa giúp ( khi bỏ đoạn code dưới ) để được kết quả như sheet KQ. Xin cảm ơn

Mã:

 N = .Range("H1").Value * 10 - 9
        STT = N - 1
    If N <= K Then
        TieuDe = .Range("I1:N1").Value
        Rws = IIf((N + 9) < K, N + 9, K)
        For I = N To Rws

Ba Tê · 2/5/18

huongmuine đã viết:
Nhờ các anh chị sửa giúp ( khi bỏ đoạn code dưới ) để được kết quả như sheet KQ. Xin cảm ơn

Mã:

N = .Range("H1").Value * 10 - 9 STT = N - 1 If N <= K Then TieuDe = .Range("I1:N1").Value Rws = IIf((N + 9) < K, N + 9, K) For I = N To Rws

Bài này quen quá!

huongmuine · 2/5/18

Ba Tê đã viết:
Bài này quen quá!

Vì đoạn code trong file được viết bởi Thầy.
Xin cảm ơn Thầy rất nhiều.

vova2209 · 2/5/18

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
    Next i
End Sub

Nhờ anh chị! vòng for này em chạy thấy chậm quá, có cách khác không ạ giúp em với. sheet dùng mảng array như nào ạ. em xin cảm ơn

HieuCD · 2/5/18

vova2209 đã viế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 Next i End Sub

Nhờ anh chị! vòng for này em chạy thấy chậm quá, có cách khác không ạ giúp em với. sheet dùng mảng array như nào ạ. em xin cảm ơn

Không biết có nhanh hơn không

Mã:

Sub SetupRowBangKL2()
Dim i As Long, hArr ()
 Redim hArr(1 to 11)
    For i = 1 To 11
        hArr(i) = Sheet23.Range("B" & i).RowHeight
    Next i
  
  For i = 1 To 11
        Sheet24.Range("B" & i).RowHeight = hArr(i)
        Sheet25.Range("B" & i).RowHeight = hArr(i)
    Next i
End Sub

vova2209 · 2/5/18

HieuCD đã viết:

Không biết có nhanh hơn không

Mã:

Sub SetupRowBangKL2()
Dim i As Long, hArr ()
Redim hArr(1 to 11)
    For i = 1 To 11
        hArr(i) = Sheet23.Range("B" & i).RowHeight
    Next i

  For i = 1 To 11
        Sheet24.Range("B" & i).RowHeight = hArr(i)
        Sheet25.Range("B" & i).RowHeight = hArr(i)
    Next i
End Sub

Anh ơi! vẫn thế a à, còn cách khác ko ạ. Dòng lệnh Sheet24, Sheet25 có thể đưa vào thành 1 dòng giống như for ko ạ. Bên trên chỉ cần khai báo có những sheet ("Sheet24", "Sheet25")

HieuCD · 2/5/18

vova2209 đã viết:
Anh ơi! vẫn thế a à, còn cách khác ko ạ. Dòng lệnh Sheet24, Sheet25 có thể đưa vào thành 1 dòng giống như for ko ạ. Bên trên chỉ cần khai báo có những sheet ("Sheet24", "Sheet25")

Mã:

Sub SetupRowBangKL2()
Dim i As Long, hArr ()
  Const sArr("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

vova2209 · 2/5/18

HieuCD đã viết:

Mã:

Sub SetupRowBangKL2()
Dim i As Long, hArr ()
  Const sArr("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

Const sArr("Sheet24","Sheet25")
Sheets(sArr(n).Range("B" & i).RowHeight = hArr(i)
2 dòng này báo lỗi mầu đỏ sai cấu trúc à anh, a xem dùm hộ em

HieuCD · 2/5/18

vova2209 đã viết:
Const sArr("Sheet24","Sheet25")
Sheets(sArr(n).Range("B" & i).RowHeight = hArr(i)
2 dòng này báo lỗi mầu đỏ sai cấu trúc à anh, a xem dùm hộ em

Thiếu vài ký tự

Mã:

Sub SetupRowBangKL2()
Dim i As Long, n As Byte, hArr()
  Const 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

vova2209 · 2/5/18

HieuCD đã viết:

Thiếu vài ký tự

Mã:

Sub SetupRowBangKL2()
Dim i As Long, n As Byte, hArr()
  Const 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

Vẫn báo lỗi dòng này a ạ!
Const sArr = Array("Sheet24", "Sheet25")

HieuCD · 3/5/18

HieuCD đã viết:

Thiếu vài ký tự

Mã:

Sub SetupRowBangKL2()
Dim i As Long, n As Byte, hArr()
  Const 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

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

truongvu317 · 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

Có lẽ nó chậm là do thao tác gán chiều cao cho dòng, nếu không giải quyết được vấn đề này thì coi như hỏng.

huongmuine · 3/5/18

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 Month(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
    End If

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 "/".

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 ạ

AnhThu-1976 · 4/5/18

Em có dựa code của thầy Ndu, để viết ra code dưới, nhưng thấy có nhiều ElseIf quá, không biết có cách nào rút gọn được không?

PHP:

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
    Dim rngCopy As Object, rngPaste As Object
    If Not Intersect(Target, Range("F1:J1")) Is Nothing Then
        Set rngCopy = Range("F1:J1")
    ElseIf Not Intersect(Target, Range("F2:J2")) Is Nothing Then
        Set rngCopy = Range("F2:J2")
    ElseIf Not Intersect(Target, Range("F3:J3")) Is Nothing Then
        Set rngCopy = Range("F3:J3")
    ElseIf Not Intersect(Target, Range("F4:J4")) Is Nothing Then
        Set rngCopy = Range("F4:J4")

    ElseIf Not Intersect(Target, Range("F5:J5")) Is Nothing Then
        Set rngCopy = Range("F5:J5")
    ElseIf Not Intersect(Target, Range("F6:J6")) Is Nothing Then
        Set rngCopy = Range("F6:J6")
    ElseIf Not Intersect(Target, Range("F7:J7")) Is Nothing Then
        Set rngCopy = Range("F7:J7")
    ElseIf Not Intersect(Target, Range("F8:J8")) Is Nothing Then
        Set rngCopy = Range("F8:J8")
    End If
    If TypeName(rngCopy) = "Range" Then
        On Error Resume Next
        Set rngPaste = Application.InputBox("Chon vùng Paste", Type:=8)
        On Error GoTo 0
        If TypeName(rngPaste) = "Range" Then rngPaste.Resize(rngCopy.Rows.Count, rngCopy.Columns.Count).Value = rngCopy.Value
    End If
End Sub

Ba Tê · 4/5/18

AnhThu-1976 đã viết:

Em có dựa code của thầy Ndu, để viết ra code dưới, nhưng thấy có nhiều ElseIf quá, không biết có cách nào rút gọn được không?

PHP:

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
    Dim rngCopy As Object, rngPaste As Object
    If Not Intersect(Target, Range("F1:J1")) Is Nothing Then
        Set rngCopy = Range("F1:J1")
    ElseIf Not Intersect(Target, Range("F2:J2")) Is Nothing Then
        Set rngCopy = Range("F2:J2")
    ElseIf Not Intersect(Target, Range("F3:J3")) Is Nothing Then
        Set rngCopy = Range("F3:J3")
    ElseIf Not Intersect(Target, Range("F4:J4")) Is Nothing Then
        Set rngCopy = Range("F4:J4")

    ElseIf Not Intersect(Target, Range("F5:J5")) Is Nothing Then
        Set rngCopy = Range("F5:J5")
    ElseIf Not Intersect(Target, Range("F6:J6")) Is Nothing Then
        Set rngCopy = Range("F6:J6")
    ElseIf Not Intersect(Target, Range("F7:J7")) Is Nothing Then
        Set rngCopy = Range("F7:J7")
    ElseIf Not Intersect(Target, Range("F8:J8")) Is Nothing Then
        Set rngCopy = Range("F8:J8")
    End If
    If TypeName(rngCopy) = "Range" Then
        On Error Resume Next
        Set rngPaste = Application.InputBox("Chon vùng Paste", Type:=8)
        On Error GoTo 0
        If TypeName(rngPaste) = "Range" Then rngPaste.Resize(rngCopy.Rows.Count, rngCopy.Columns.Count).Value = rngCopy.Value
    End If
End Sub

Không biết ý bạn muốn làm là gì thì làm sao rút gọn?

HieuCD · 4/5/18

AnhThu-1976 đã viết:

Em có dựa code của thầy Ndu, để viết ra code dưới, nhưng thấy có nhiều ElseIf quá, không biết có cách nào rút gọn được không?

PHP:

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
    Dim rngCopy As Object, rngPaste As Object
    If Not Intersect(Target, Range("F1:J1")) Is Nothing Then
        Set rngCopy = Range("F1:J1")
    ElseIf Not Intersect(Target, Range("F2:J2")) Is Nothing Then
        Set rngCopy = Range("F2:J2")
    ElseIf Not Intersect(Target, Range("F3:J3")) Is Nothing Then
        Set rngCopy = Range("F3:J3")
    ElseIf Not Intersect(Target, Range("F4:J4")) Is Nothing Then
        Set rngCopy = Range("F4:J4")

    ElseIf Not Intersect(Target, Range("F5:J5")) Is Nothing Then
        Set rngCopy = Range("F5:J5")
    ElseIf Not Intersect(Target, Range("F6:J6")) Is Nothing Then
        Set rngCopy = Range("F6:J6")
    ElseIf Not Intersect(Target, Range("F7:J7")) Is Nothing Then
        Set rngCopy = Range("F7:J7")
    ElseIf Not Intersect(Target, Range("F8:J8")) Is Nothing Then
        Set rngCopy = Range("F8:J8")
    End If
    If TypeName(rngCopy) = "Range" Then
        On Error Resume Next
        Set rngPaste = Application.InputBox("Chon vùng Paste", Type:=8)
        On Error GoTo 0
        If TypeName(rngPaste) = "Range" Then rngPaste.Resize(rngCopy.Rows.Count, rngCopy.Columns.Count).Value = rngCopy.Value
    End If
End Sub

Thử code

Mã:

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
    Dim rngCopy As Object, rngPaste As Object
    If Target.Column >= 6 And Target.Column <= 10 and Target.Row <= 8 Then
        Set rngCopy = Range("F" & Target.Row).Resize(, 5)
        On Error Resume Next
        Set rngPaste = Application.InputBox("Chon vùng Paste", Type:=8)
        On Error GoTo 0
        If TypeName(rngPaste) = "Range" Then rngPaste.Resize(rngCopy.Rows.Count, rngCopy.Columns.Count).Value = rngCopy.Value
    End If
End Sub

Hoặc

Mã:

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
    Dim rngCopy As Object, rngPaste As Object
    If Not Intersect(Target, Range("F1:J8")) Is Nothing Then
        Set rngCopy = Range("F" & Target.Row).Resize(, 5)
        On Error Resume Next
        Set rngPaste = Application.InputBox("Chon vùng Paste", Type:=8)
        On Error GoTo 0
        If TypeName(rngPaste) = "Range" Then rngPaste.Resize(rngCopy.Rows.Count, rngCopy.Columns.Count).Value = rngCopy.Value     
    End If
End Sub

VetMini · 4/5/18

For each rgAddr in Array("F1:J1", "F2:J2", ...)
If Not Intersect(target, Range(rgAddr)) Is Nothing Then
Set rgCopy = Range(rgAddr)
Exit For
End If
Next rgAddr

Cái lỗi chính của code bạn không ở chỗ If Else nhiều, mà là ở chỗ lặp đi lặp lại mấy cái tên range nhiều quá. Trong nghề lập trình, cái này là lỗi code khó kiểm soát.

Hâu hết các bậc trưởng thượng ở diễn đàn này chỉ chú ý vào tốc độ code và số dòng code chứ không hề khuyến khích người mới học căn bản. Vòng lặp for nằm trong phần căn bản nhất của lập trình. Nhìn vào một cái gì lặp đi lặp lại thì phải nghĩ đến vòng lặp. Ở đây, cái vòng lặp của tôi khong chỉ cốt thâu gọn code, nó còn có mục đích chỉ kể đến cái string range mỗi cái đúng 1 lần -> chỉ có một chỗ để kiểm soát.

truongvu317 · 4/5/18

vova2209 đã viết:
Code mới rút gọn lại hơn hay như nào chị tư vấn cho em với ạ

Chém gió chut! Hôm qua ai nói chuyện "xoẹt xoẹt" ấy, giờ anh "Vẹt Nhỏ" đã đổi giới tính rồi hay sao.

truongvu317 · 4/5/18

vova2209 đã viết:
[QUOTE="HieuCD

[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

[/QUOTE]
Tui cảm nhận hai code này chả khác nhau về mặt ý tưởng, thậm chí code đầu tiên còn cực yếu là khác. Cuối cùng mà nói bạn vẫn phải tìm cách lấy tham chiếu tới từng sheet để thao tác, code của bạn chính ra lại trong sáng, dài hơn vài dòng không là cái gì cả. Nếu đã dùng namecode để truy cập thì thà rằng viết là array(sheet1,sheet2....) cho nó nhanh, đỡ phải mất công dò tìm tham chiếu, có luôn mà dùng. Với cách viết này ta còn được vba hỗ trợ gợi ý khi viết code, ví dụ khi gõ là shee thì vba sẽ liệt kê ra tất cả những cái liên quan, dùng chuột chọn là xong, không thể nhầm lẫn khi viết là sheet1.... Mà nếu có thay đổi namecode, vba sẽ báo lỗi ngay trước khi cho chạy.

vova2209 · 4/5/18

truongvu317 đã viết:
[QUOTE="Befait

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

[/QUOTE]
Tui cảm nhận hai code này chả khác nhau về mặt ý tưởng, thậm chí code đầu tiên còn cực yếu là khác. Cuối cùng mà nói bạn vẫn phải tìm cách lấy tham chiếu tới từng sheet để thao tác, code của bạn chính ra lại trong sáng, dài hơn vài dòng không là cái gì cả. Nếu đã dùng namecode để truy cập thì thà rằng viết là array(sheet1,sheet2....) cho nó nhanh, đỡ phải mất công dò tìm tham chiếu, có luôn mà dùng. Với cách viết này ta còn được vba hỗ trợ gợi ý khi viết code, ví dụ khi gõ là shee thì vba sẽ liệt kê ra tất cả những cái liên quan, dùng chuột chọn là xong, không thể nhầm lẫn khi viết là sheet1.... Mà nếu có thay đổi namecode, vba sẽ báo lỗi ngay trước khi cho chạy.[/QUOTE]
Mình muốn dùng codeName để khi đổi tên ko ảnh hưởng tới code. Và cũng thử cách khác xem tốc độ code chạy có tốt hơn không?
làm thế nào cho dòng này ngắn lại nhỉ bạn: Sheet23.Range("B" & i).RowHeight .
Dim ws23 as WorkSheets
Set ws23 = Sheet23.Range("B" & i).RowHeight lại bị báo lỗi

VetMini · 4/5/18

truongvu317 đã viết:
...
Tui cảm nhận hai code này chả khác nhau về mặt ý tưởng, thậm chí code đầu tiên còn cực yếu là khác. ....

Thì chính người hỏi muốn cho nó chớp cho đẹp mắt mờ.

vova2209 đã viết:
...
Dim ws23 as WorkSheets
Set ws23 = Sheet23.Range("B" & i).RowHeight lại bị báo lỗi

Cái phần màu xanh nó là thuộc tính của range, phần màu đỏ là sheet.
Code loạn xà ngầu, Đem râu ông nọ cắm cằm bà kia may là nó báo lỗi. Chứ nó lẳng lặng sửa sai dữ liệu thì ở đấy mà khóc.[/QUOTE]

truongvu317 · 4/5/18

VetMini đã viết:
Thì chính người hỏi muốn cho nó chớp cho đẹp mắt mờ.

Cái phần màu xanh nó là thuộc tính của range, phần màu đỏ là sheet.
Code loạn xà ngầu, Đem râu ông nọ cắm cằm bà kia may là nó báo lỗi. Chứ nó lẳng lặng sửa sai dữ liệu thì ở đấy mà khóc.

Nói chung là cứ đi copy, chả hiểu ngọn nguồn gì thì cũng mệt lắm.

VetMini · 4/5/18

truongvu317 đã viết:
...
Tui cảm nhận hai code này chả khác nhau về mặt ý tưởng {1}, thậm chí code đầu tiên còn cực yếu {2} là khác. Cuối cùng mà nói bạn vẫn phải tìm cách lấy tham chiếu tới từng sheet để thao tác, code của bạn chính ra lại trong sáng {3}, dài hơn vài dòng không là cái gì cả. Nếu đã dùng namecode để truy cập thì thà rằng viết là array(sheet1,sheet2....) cho nó nhanh {4} đỡ phải mất công dò tìm tham chiếu, có luôn mà dùng. Với cách viết này ta còn được vba hỗ trợ gợi ý khi viết code, ví dụ khi gõ là shee thì vba sẽ liệt kê ra tất cả những cái liên quan {5}, dùng chuột chọn là xong, không thể nhầm lẫn khi viết là sheet1.... Mà nếu có thay đổi namecode, vba sẽ báo lỗi ngay trước khi cho chạy.

{1} Theo kỹ thuật lập trình thì rất khác nhau về mặt ý tưởng. Một code dùng vòng lặp sẽ nhấn mạnh ở điểm rằng các Range của mỗi sheet sẽ giống nhau. Code kia nêu từng sheet ra, cho nên phải đọc hết từng Range mới biết chúng giống nhau.
(thật sự cũng có cách chọn dòng của nhóm sheets và sửa luôn một lúc. Nhưng người hỏi code muốn nó chạy đẹp mắt cho nên tôi không buồn bàn tới)

{2} yếu hay mạnh là chuyện chủ quan, tôi khong nói tới.

{3} xem luận lý ở {1}, tùy theo chủ ý và trường phái code mà bên nào sẽ trong sáng hơn. Theo luật thống kê thì nếu số sheets khoảng 2-3 thì đúng là trong sáng hơn, 4-5 sheets thì tương đương, 6+ sheets thì sự trong sáng nghiêng về bên vòng lặp.

{4} dùng luôn array(sheet1, sheet2, ...) đúng là cách gọn nhất. Tuy nhiên, đó là cách gọi trực tiếp đối tượng sheet.
Ở đay, code trên chỉ là biểu diễn trường hợp dùng string array mà vẫn đề cập được sheet qua codename. Dùng string array uyển chuyển hơn, ví dụ đầu module có một string cho biết tên của các sheets liên quan.

{5} Điều này không hẳn quan trọng. Có nhiều cách để VBA liệt kê phương thức và thuộc tính của đối tượng.

truongvu317 · 4/5/18

VetMini đã viết:
Điều này không hẳn quan trọng. Có nhiều cách để VBA liệt kê phương thức và thuộc tính của đối tượng.

Giả sử có sheet1, nếu viết là "sheetl" sẽ không có bất cứ thông báo nào cho tới khi code chạy bị lỗi, còn nếu cố ý viết là SheetL thì lúc dịch sẽ báo lỗi ngay, em muốn đề cập tới vấn đề đó.

VetMini · 4/5/18

truongvu317 đã viết:
Giả sử có sheet1, nếu viết là "sheetl" sẽ không có bất cứ thông báo nào cho tới khi code chạy bị lỗi, còn nếu cố ý viết là SheetL thì lúc dịch sẽ báo lỗi ngay, em muốn đề cập tới vấn đề đó.

Dựa vào điều này để tránh lỗi code thì tôi bó tay, không dám bàn cãi tiếp.

vova2209 · 4/5/18

VetMini đã viết:
Thì chính người hỏi muốn cho nó chớp cho đẹp mắt mờ.

Cái phần màu xanh nó là thuộc tính của range, phần màu đỏ là sheet.
Code loạn xà ngầu, Đem râu ông nọ cắm cằm bà kia may là nó báo lỗi. Chứ nó lẳng lặng sửa sai dữ liệu thì ở đấy mà khóc.

[/QUOTE]
Thực ra toàn nhờ anh chị viết code cho để ứng dụng làm cho nhanh, vừa nhờ vừa tìm hiểu nên còn bỡ ngỡ em sẽ cố gắng nhiều. Cảm ơn a chị GPE đã giúp nhiều

mdk18 · 6/5/18

Xin chào mọi người..mình gặp 1 số vấn đề về mở 1 file excel 2016 thì bị báo lỗi như hình dưới..ko biết có ae nào khắc phục được giúp mình ko ạ..xin cảm ơn trước. Máy mình win 10 32bit

keke355992 · 6/5/18

Chào các bạn. Mình xin hỏi chút về vấn đề sau: Mình có nhiều Sheet trong Workbook., Ví dụ: Sheets("A"); Sheets("B"); Sheets("C").... Vậy dùng câu lệnh nào có thể lấy đc tên Sheet mình vừa DeActivate. Ví dụ: đang ở sheets("A"), mà bấm chọn Sheet bất kỳ thì có 1 Msgbox hiện "A" ....
( ActivateSheet.Name - nhưng nó chỉ lấy sheet hiện hành, chứ kp là lấy tên Sheet vừa đi qua xong )

befaint · 6/5/18

keke355992 đã viết:
Chào các bạn. Mình xin hỏi chút về vấn đề sau: Mình có nhiều Sheet trong Workbook., Ví dụ: Sheets("A"); Sheets("B"); Sheets("C").... Vậy dùng câu lệnh nào có thể lấy đc tên Sheet mình vừa DeActivate. Ví dụ: đang ở sheets("A"), mà bấm chọn Sheet bất kỳ thì có 1 Msgbox hiện "A" ....
( ActivateSheet.Name - nhưng nó chỉ lấy sheet hiện hành, chứ kp là lấy tên Sheet vừa đi qua xong )

keke355992 · 6/5/18

Cám ơn befaint, mình k nghĩ ra là dùng sự kiện WorkBook. Cứ loay hoay WorkSheet

♫ђöล♥ßล†♥†µ♫ · 6/5/18

keke355992 đã viết:
Chào các bạn. Mình xin hỏi chút về vấn đề sau: Mình có nhiều Sheet trong Workbook., Ví dụ: Sheets("A"); Sheets("B"); Sheets("C").... Vậy dùng câu lệnh nào có thể lấy đc tên Sheet mình vừa DeActivate. Ví dụ: đang ở sheets("A"), mà bấm chọn Sheet bất kỳ thì có 1 Msgbox hiện "A" ....
( ActivateSheet.Name - nhưng nó chỉ lấy sheet hiện hành, chứ kp là lấy tên Sheet vừa đi qua xong )

Như thế này cũng được anh ạ

Mã:

Option Explicit
Public Str As String
Private Sub Workbook_SheetDeactivate(ByVal Sh As Object)
    Str = Sh.Name
    MsgBox Str
End Sub

befaint · 6/5/18

♫ђöล♥ßล†♥†µ♫ đã viết:
Như thế này cũng được anh ạ

Mã:

Option Explicit Public Str As String Private Sub Workbook_SheetDeactivate(ByVal Sh As Object) Str = Sh.Name MsgBox Str End Sub

Thế viết luồn vầy. =))

PHP:

Private Sub Workbook_SheetDeactivate(ByVal Sh As Object)
    MsgBox Sh.Name
End Sub

vova2209 · 11/5/18

Cho em hỏi! Em đang đứng tại sheet22 gọi code nó chạy ở sheet21 Code dưới đã đúng chưa ạ. Em xin cảm ơn
With Sheets("Sheet21")
code
...
End With

ndu96081631 · 11/5/18

vova2209 đã viết:
Cho em hỏi! Em đang đứng tại sheet22 gọi code nó chạy ở sheet21 Code dưới đã đúng chưa ạ. Em xin cảm ơn
With Sheets("Sheet21")
code
...
End With

Bạn thử thì biết được hay không liền chứ sao lại hỏi?

lengoctan · 11/5/18

Các bác có thể giúp em là em bị lỗi gì ko ạ. Do em tay ngang vọc vba nên cũng ko được bài bản lắm. Gặp lỗi là đứng hình ko hiểu tại sao? Rât mong được sự giúp đỡ ạ!

vova2209 · 11/5/18

ndu96081631 đã viết:
Bạn thử thì biết được hay không liền chứ sao lại hỏi?

Chạy báo lỗi thầy ơi! giúp em với ạ

♫ђöล♥ßล†♥†µ♫ · 11/5/18

vova2209 đã viết:
Chạy báo lỗi thầy ơi! giúp em với ạ

Nhưng mà nó lỗi làm sao cơ chứ. Có 1001 lỗi đâu biết lỗi của bạn số thứ tự bao nhiêu

AutoReply · 11/5/18

♫ђöล♥ßล†♥†µ♫ đã viết:
Nhưng mà nó lỗi làm sao cơ chứ. Có 1001 lỗi đâu biết lỗi của bạn số thứ tự bao nhiêu

dạ em bị mã lỗi 1001. giúp em với

♫ђöล♥ßล†♥†µ♫ · 11/5/18

AutoReply đã viết:
dạ em bị mã lỗi 1001. giúp em với

Chị mà lỗi thì có nước là dừng tại chỗ. He he "Xe hơi xẹp lốp"

VetMini · 11/5/18

vova2209 đã viết:
Cho em hỏi! Em đang đứng tại sheet22 gọi code nó chạy ở sheet21 Code dưới đã đúng chưa ạ. Em xin cảm ơn
With Sheets("Sheet21")
code
...
End With

Thường thì không đúng.
Đây chỉ là nói đúng sai thôi, còn lỗi phải lại là chuyện khác.

vova2209 · 11/5/18

VetMini đã viết:
Thường thì không đúng.
Đây chỉ là nói đúng sai thôi, còn lỗi phải lại là chuyện khác.

Như này sai chỗ nào a nhỉ.. đang đứng ở sheet22

Mã:

Sub GopDuLieu_Delete()
    Dim lr As Long
With Sheet21
    lr = Range("A9999").End(xlUp).row
    Range("BA3:BC" & lr).ClearContents
End With
End Sub

♫ђöล♥ßล†♥†µ♫ · 11/5/18

vova2209 đã viết:
Như này sai chỗ nào a nhỉ.. đang đứng ở sheet22

Mã:

Cái này thì thiếu dấu chấm rồi lr = .Range("A9999").End(xlUp).row .Range("BA3:BC" & lr).ClearContents

vova2209 · 11/5/18

à à! được rồi, em cảm ơn chị nhiều

truongvu317 · 11/5/18

lengoctan đã viết:
Các bác có thể giúp em là em bị lỗi gì ko ạ. Do em tay ngang vọc vba nên cũng ko được bài bản lắm. Gặp lỗi là đứng hình ko hiểu tại sao? Rât mong được sự giúp đỡ ạ!View attachment 195302

Cho chết! cái tội cẩu tha khi viết code.

Mã:
Mã:

Dim SBD As Double SDB = 16

Lẽ ra phải là SBD=16 thì lại viết là SDB=16.

Mà người ta dùng Long là được rùi, không cần sài Double.

Hoang2013 · 11/5/18

lengoctan đã viết:
Các bác có thể giúp em là em bị lỗi gì ko ạ. Do em tay ngang vọc vba nên cũng ko được bài bản lắm.. . . .

Để vẫn có thể ẩu tả 1 cách đúng đắn, ta xài tên tham biến cho thích hợp;
Ví dụ Nên là SoBD hay sBD thay vì SBD

lengoctan · 12/5/18

truongvu317 đã viết:
Cho chết! cái tội cẩu tha khi viết code.

Lẽ ra phải là SBD=16 thì lại viết là SDB=16.

Mà người ta dùng Long là được rùi, không cần sài Double.

Em cảm ơn ạ. Em ko rà hết biến và ko ngờ mà sai cơ bản đến vậy. Cảm ơn mọi người ạ.

vova2209 · 12/5/18

Chào anh chị!
em muốn cho 1 vùng thành value thì phải làm thế nào ạ
Ví dụ: vùng cần chuyển sang value từ L6:AF
Công thức em làm báo lỗi

Mã:

    Dim lr As Long
    lr = Range("A9999").End(xlUp).row
    Range("L6:AF" & lr).Value

HieuCD · 12/5/18

vova2209 đã viết:
Chào anh chị!
em muốn cho 1 vùng thành value thì phải làm thế nào ạ
Ví dụ: vùng cần chuyển sang value từ L6:AF
Công thức em làm báo lỗi

Mã:

Dim lr As Long lr = Range("A9999").End(xlUp).row Range("L6:AF" & lr).Value

Thêm = chính nó

vova2209 · 12/5/18

HieuCD đã viết:
Thêm = chính nó

là như nào ạ! a chỉnh cho em xem với

giaiphap · 12/5/18

vova2209 đã viết:
Chào anh chị!
em muốn cho 1 vùng thành value thì phải làm thế nào ạ
Ví dụ: vùng cần chuyển sang value từ L6:AF
Công thức em làm báo lỗi

Mã:

Dim lr As Long lr = Range("A9999").End(xlUp).row Range("L6:AF" & lr).Value

Dòng cuối = dòng cuối.

HieuCD · 12/5/18

vova2209 đã viết:
là như nào ạ! a chỉnh cho em xem với

Range("L6:AF" & lr).Value=Range("L6:AF" & lr).Value

vova2209 · 12/5/18

HieuCD đã viết:
Range("L6:AF" & lr).Value=Range("L6:AF" & lr).Value

vâng được rồi, nãy em để Range("L6:AF" & lr) = Range("L6:AF" & lr).Value
Cảm ơn a nhiều!

lameco411 · 18/5/18

Chào các bác! e có một vấn đề như thế này! Em có một cột dữ liệu như màu vàng, giờ em muốn chuyển dữ liệu sang ô màu xanh theo thứ tự giống như hình!
Em có viết code như thế này!
Sub dichuyen()
Dim vungchuyen As Range
Dim obatdau As Range
Dim tang As Integer
Dim mang As Variant
Dim i, j As Long
Dim c As Long
Set vungchuyen = Selection
mang = vungchuyen.Value
Set obatdau = Sheet6.Range(InputBox("nhap o bat dau"))
c = 0
i = 0
Do
j = 0
Do
obatdau.Offset(j * -1, i).Value = i + j + 2 * c
j = j + 1
Loop Until j = 3 Or i + j + 2 * c > UBound(mang) - 1
c = c + 1
i = i + 1
Loop While i + j + 2 * c <= UBound(mang) + 2
End Sub

thì đã đi tới đây

giờ có số thứ tự hết rồi mà khi em đưa số thứ tự đó vô mảng nó lại báo lỗi

Em không biết nó sai chỗ nào mong các bác chỉ giáo!

hichlehg · 18/5/18

Chào các bác.
Mình muốn trích xuất đường dẫn URL của hyperlink theo hướng dẫn của video này nhưng mình không biết gì về VBA nhờ các bác xem và hưởng dẫn mình với.
Clip hướng dẫn:

Mình đã làm

Tran Dinh Thinh · 18/5/18

Dear a,

A giúp về đoạn Code này với. Ở sheet "KETQUA" có cell C1 được link với sheet đầu tiên. Khi cell C1 thay đổi thì nó sẽ chạy VBA lọc ra dữ liệu theo ý e muốn. Tuy nhiên e phải Manual kích vào và nhấn Enter thi VBA mới chạy chứ k tự động chạy khi e thay đổi dữ liệu ở Sheet đầu tiên.

A vui lòng hỗ trợ giúp em

Ba Tê · 18/5/18

lameco411 đã viết:
View attachment 195689
Chào các bác! e có một vấn đề như thế này! Em có một cột dữ liệu như màu vàng, giờ em muốn chuyển dữ liệu sang ô màu xanh theo thứ tự giống như hình!
Em có viết code như thế này!
Sub dichuyen()
Dim vungchuyen As Range
Dim obatdau As Range
Dim tang As Integer
Dim mang As Variant
Dim i, j As Long
Dim c As Long
Set vungchuyen = Selection
mang = vungchuyen.Value
Set obatdau = Sheet6.Range(InputBox("nhap o bat dau"))
c = 0
i = 0
Do
j = 0
Do
obatdau.Offset(j * -1, i).Value = i + j + 2 * c
j = j + 1
Loop Until j = 3 Or i + j + 2 * c > UBound(mang) - 1
c = c + 1
i = i + 1
Loop While i + j + 2 * c <= UBound(mang) + 2
End Sub

thì đã đi tới đây
View attachment 195690
giờ có số thứ tự hết rồi mà khi em đưa số thứ tự đó vô mảng nó lại báo lỗi
View attachment 195691
Em không biết nó sai chỗ nào mong các bác chỉ giáo!

Bạn đưa file lên và giải thích rõ ý bạn muốn có kết quả thế nào, quy luật gì... có thể có người giúp bạn, chứ bạn biểu đọc code của bạn và hiểu bạn muốn gì thì oải lắm.

phulien1902 · 18/5/18

hichlehg đã viết:
Chào các bác.
Mình muốn trích xuất đường dẫn URL của hyperlink theo hướng dẫn của video này nhưng mình không biết gì về VBA nhờ các bác xem và hưởng dẫn mình với.
Clip hướng dẫn:

Mình đã làm
View attachment 195692 View attachment 195692

Bạn xem bài viết dưới đây thử coi
https://blog.hocexcel.online/cach-lay-dia-chi-tu-cac-hyperlink-trong-excel.html

hichlehg · 18/5/18

phulien1902 đã viết:
Bạn xem bài viết dưới đây thử coi
https://www.giaiphapexcel.com/diendan/threads/chuyên-mục-xử-lý-gỡ-rối-code-vba.85576/page-86

Link bạn gửi mình mở bị lỗi
Thanks

phulien1902 · 18/5/18

hichlehg đã viết:
Link bạn gửi mình mở bị lỗi
Cảm ơn

Tôi gửi lại rồi đấy. Đó là Blog của bạn Thanh

hichlehg · 18/5/18

phulien1902 đã viết:
Tôi gửi lại rồi đấy. Đó là Blog của bạn Thanh

Mình cũng có làm giống như vậy nữa.
Nhưng có lẽ mình đánh sai ký tự gì hả gì á, mà nó ko ra bao lỗi có dẫu nháy mà chổ nháy đâu có sai.

hichlehg · 18/5/18

phulien1902 đã viết:
Tôi gửi lại rồi đấy. Đó là Blog của bạn Thanh

Mình làm được rồi, nhưng nó mất nội dung ô đó hết, mình copy qua làm tạm. Thấy cách trong video đúng ý mình cần á, mà làm không được.
Cám ơn bạn!

befaint · 18/5/18

hichlehg đã viết:
Mình làm được rồi, nhưng nó mất nội dung ô đó hết, mình copy qua làm tạm. Thấy cách trong video đúng ý mình cần á, mà làm không được.
Cám ơn bạn!

hichlehg · 18/5/18

Đúng rồi. Mình muốn vậy nè.
Cám ơn bạn rất nhiều!

AutoReply · 26/5/18

em có thu Macro như này.

Mã:

Sub Macro1()

Range("B2").Select

Selection.Copy

Sheets(Array("2", "3", "4")).Select

Sheets("2").Activate

Range("B2").Select

ActiveSheet.Paste

End Sub

Sau đó em sửa là:

Mã:

Sub Macro2()

Sheets("1").Range("B2").Copy.Sheets(Array("2", "3", "4")).Range("B5").Paste



End Sub

Nhưng nó không chạy được.
Nhờ các bạn hướng dẫn mình với.
Cảm ơn các bạn.

phulien1902 · 26/5/18

AutoReply đã viết:
em có thu Macro như này.

Mã:

Sub Macro1() Range("B2").Select Selection.Copy Sheets(Array("2", "3", "4")).Select Sheets("2").Activate Range("B2").Select ActiveSheet.Paste End Sub

Sau đó em sửa là:

Mã:

Sub Macro2() Sheets("1").Range("B2").Copy.Sheets(Array("2", "3", "4")).Range("B5").Paste End Sub

Nhưng nó không chạy được.
Nhờ các bạn hướng dẫn mình với.
Cảm ơn các bạn.

Có lẽ bạn không muốn dùng vòng lặp For..

PHP:

Sub abc()
  Dim i As Byte
    For i = 2 To 4
      Sheets(i).[b5] = Sheet1.[b2]
    Next
End Sub

huongmuine · 26/5/18

Xin nhờ các anh chị chỉnh giúp đoạn code trong file. Khi thêm đoạn code bên dưới vào thì kết quả cột K không chính xác. Ở những dòng tô màu tại cột K so với cột M

Mã:

            dArr(K, 11) = IIf(sArr(K, 21) <> Empty, sArr(K, 21), sArr(K, 35))

Xin cảm ơn.

PacificPR · 27/5/18

phulien1902 đã viết:
Có lẽ bạn không muốn dùng vòng lặp For..

PHP:

Sub abc() Dim i As Byte For i = 2 To 4 Sheets(i).[b5] = Sheet1.[b2] Next End Sub

Anh tin chị ấy thì có nước đổ thóc giống ra mà ăn

HieuCD · 27/5/18

PacificPR đã viết:
Anh tin chị ấy thì có nước đổ thóc giống ra mà ăn

Chời ơi! topic đang "ế" có anh kiệt nhảy vào ra tay tương trợ, bạn đành lòng ngăn cản để "ế" tiếp à.

AutoReply · 27/5/18

PacificPR đã viết:
Anh tin chị ấy thì có nước đổ thóc giống ra mà ăn

ủa bạn nói gì mình không hiểu ? mình nhờ các bạn diễn đàn giúp, sao bạn nỡ nói vậy ?

ndu96081631 · 27/5/18

AutoReply đã viết:
em có thu Macro như này.

Mã:

Sub Macro1() Range("B2").Select Selection.Copy Sheets(Array("2", "3", "4")).Select Sheets("2").Activate Range("B2").Select ActiveSheet.Paste End Sub

Sau đó em sửa là:

Mã:

Sub Macro2() Sheets("1").Range("B2").Copy.Sheets(Array("2", "3", "4")).Range("B5").Paste End Sub

Nhưng nó không chạy được.
Nhờ các bạn hướng dẫn mình với.
Cảm ơn các bạn.

Định đố hay sao ấy chứ

Mã:

Sheets(Array("1", "2", "3", "4")).FillAcrossSheets Sheets("1").Range("B2")

(Nếu tôi nhớ không lầm thì tôi đã từng đố câu gần tương tự trong mục đối vui về VBA)

Chuyên mục xử lý, gỡ rối code VBA (1 người xem)

Người dùng đang xem chủ đề này

Huyền thoại GPE

Thành viên mới

Thành viên gạo cội

Thành viên mới

Thành viên mới

File đính kèm

Thành viên gạo cội

Thành viên mới

Thành viên gạo cội

Thành viên chính thức

Thành viên chính thức

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

Thành viên GPE

File đính kèm

Cạo Rồi Khỏi Gội

File đính kèm

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

Chuyên gia GPE

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

Thành viên 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

Đang đi tìm hòn đá

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

Đang đi tìm hòn đá

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

Đang đi tìm hòn đá

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

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

Cạo Rồi Khỏi Gội

Chuyên gia GPE

Đang đi tìm hòn đá

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

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

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

Đang đi tìm hòn đá

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

Đang đi tìm hòn đá

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

Đang đi tìm hòn đá

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

Thành viên mới

File đính kèm

Thành viên thường trực

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

File đính kèm

Thành viên thường trực

Thành viên tiêu biểu

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

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

Huyền thoại GPE

Thành viên mới

File đính kèm

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

Thành viên tiêu biểu

Thành viên tiêu biểu