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")

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

Đếm ngược thời gian