Ghép dòng với nhiều điều kiện

  • Thread starter Thread starter pt_hcl
  • Ngày gửi Ngày gửi
Liên hệ QC
ChanhTQ@ đã viết:
Thay vì
Mã: 
[SIZE=3][FONT=Times New Roman]Dim eCol As Byte, eRw As Long, jJ As Long, Max_ As Byte, SoOR As Byte

Ta thử sửa lại là :
PHP: 
Dim eCol As Long, eRw As Long, jJ As Long, Max_ As Byte, SoOR As Byte
[/FONT][/SIZE]
Nhấp chuột vào đây để mở rộng...

Hix, Không ngủ được dậy nghiên cứu! Cảm ơn bạn ChanhTQ nhiều!
 
Bài toán tổng quát của bạn sẽ kết thúc trong nay mai 1 cách hoàn mĩ!

& đây là macro xét 3 dòng cho trường hợp 5 ô trống!

PHP: 
 Sub GPE

 ' Xin Các Bạn Xem Bài Bên Dưới Liền Kề Trích Dẫn Đầy Đủ'

End Sub

(Trước khi ta đến trường hợp tổng quát với 3 dòng:)

Xin hỏi anh Cò Già chút: Đáng fạt tác gia topic do mô tả công việc lượm thượm không nhỉ?
 
Chỉnh sửa lần cuối bởi điều hành viên:
HYen17 đã viết:
& đây là macro xét 3 dòng cho trường hợp 5 ô trống!

PHP: 
Option Explicit
 
Sub Ghep3Dong_5()
Dim Rws As Long, Col As Integer, Jj As Long, wW As Long, zZ As Long
Dim jRg As Range, wRg As Range, zRg As Range, WF As Object, Sh As Worksheet
Dim Max_ As Byte, Timer_ As Double: Const Ct As Integer = 256
 
Timer_ = Timer: Sheet1.Select
Rws = [A65500].End(xlUp).Row: Set Sh = Sheets("S5") '<=|'
Sh.[A1].Resize(9 * Rws, Ct).Clear:
Set WF = Application.WorksheetFunction
For Jj = 4 To Rws - 2
Set jRg = Range(Cells(Jj, "B"), Cells(Jj, "IU"))
If WF.Sum(jRg(1).Resize(, 5)) = 0 Then '5:=Num'
For wW = Jj + 1 To Rws - 1
Set wRg = Range(Cells(wW, "B"), Cells(wW, "IU"))
If WF.Sum(wRg(1).Resize(, 5)) = 0 Then '5:=Num'
For zZ = wW + 1 To Rws
Set zRg = Range(Cells(zZ, "B"), Cells(zZ, "IU"))
If WF.Sum(zRg(1).Resize(, 5)) = 0 Then '5:=Num'
With Sh.[A65500].End(xlUp).Offset(2)
.Resize(, Ct).Value = jRg(0).Resize(, Ct).Value
.Offset(1).Resize(, Ct).Value = wRg(0).Resize(, Ct).Value
.Offset(2).Resize(, Ct).Value = zRg(0).Resize(, Ct).Value
End With
End If
Next zZ
End If
Next wW
End If
Next Jj
 
Sh.Select: Set Sh = Nothing
Rws = [A65500].End(xlUp).Row + 1: Set zRg = [A1]
For Jj = 3 To Rws Step 4
Cells(Jj, 1).Interior.ColorIndex = 45
For wW = (5 + 2) To Ct '5:=Num'
Set jRg = Cells(1, wW): Set wRg = jRg.Offset(, -1)
With Cells(Jj, wW)
jRg.Value = .Value + .Offset(1).Value + .Offset(2).Value
End With
If jRg.Value = 0 And wRg.Value = 0 Then
Col = Col + 1
If Max_ < Col Then Max_ = Col
If Max_ > 5 - 1 Then Exit For '5:=Num'
Else
Col = 0
End If
Next wW
If Max_ <> 5 - 1 Then '5:=Num'
Set zRg = Union(zRg, Cells(Jj, 1).Resize(3))
End If
Max_ = 0: Col = 0
Next Jj
zRg.EntireRow.Delete: [A1].Value = "GPE"
[B1].Value = Timer - Timer_
End Sub



(Trước khi ta đến trường hợp tổng quát với 3 dòng:)

Xin hỏi anh Cò Già chút: Đáng fạt tác gia topic do mô tả công việc lượm thượm không nhỉ?
Nhấp chuột vào đây để mở rộng...

- Hì! Vâng! Mình xin nhận lỗi để lần sau rút kinh nghiệm! Cảm ơn bạn HYen nhiều lắm! Tin này của bạn có thể nói là tin vui nhất trong ngày!
- Cảm ơn các bạn, cảm ơn GPE! Mong chờ tin tốt lành tiếp theo! Thân ái!
 
Đây nè bạn, đủ rồi đó nha

Mã: 
[B]Sub Ghep3Dong()[/B]
 Dim Nomer As Byte
 
 Nomer = InputBox("Hay Nhap So Tri: ", "GPE Xin Luu Y: < 11", "5")
 GPE Nomer
[B]End Sub[/B]
PHP: 
Sub GPE(Num)
 Dim Rws As Long, Col As Integer, Jj As Long, wW As Long, zZ As Long
 Dim jRg As Range, wRg As Range, zRg As Range, WF As Object, Sh As Worksheet
 Dim Max_ As Byte, Timer_ As Double:            Const Ct As Integer = 256
 
 Timer_ = Timer:                                Sheet1.Select
 Rws = [A65500].End(xlUp).Row:                  Set Sh = Sheets("S5") '<=|'
 Sh.Range(Sh.[A1], Sh.[A65500].End(xlUp)).Resize(, Ct).Clear:
 Set WF = Application.WorksheetFunction
 For Jj = 4 To Rws - 2
    Set jRg = Range(Cells(Jj, "B"), Cells(Jj, "IU"))
    Set jRg = Cells(Jj, "B").Resize(, Ct - 2)
    If WF.Sum(jRg(1).Resize(, Num)) = 0 Then     '*'
        For wW = Jj + 1 To Rws - 1
            Set wRg = Cells(wW, "B").Resize(, Ct - 2)
            If WF.Sum(wRg(1).Resize(, Num)) = 0 Then         '*'
                For zZ = wW + 1 To Rws
                    Set zRg = Cells(zZ, "B").Resize(, Ct - 2)
                    If WF.Sum(zRg(1).Resize(, Num)) = 0 Then         '*'
                        With Sh.[A65500].End(xlUp).Offset(2)
                            .Resize(, Ct).Value = jRg(0).Resize(, Ct).Value
                            .Offset(1).Resize(, Ct).Value = wRg(0).Resize(, Ct).Value
                            .Offset(2).Resize(, Ct).Value = zRg(0).Resize(, Ct).Value
                        End With
                    End If
                Next zZ
            End If
        Next wW
    End If
 Next Jj
 Sh.Select:                                 Set Sh = Nothing
 [c2].Value = Timer - Timer_
 Rws = [A65500].End(xlUp).Row + 1:          Set zRg = [A1]
 For Jj = 3 To Rws Step 4
    Cells(Jj, 1).Interior.ColorIndex = 45
    For wW = (Num + 2) To Ct                  '*'
        Set jRg = Cells(1, wW):             Set wRg = jRg.Offset(, -1)
        With Cells(Jj, wW)
            jRg.Value = .Value + .Offset(1).Value + .Offset(2).Value
        End With
        If jRg.Value = 0 And wRg.Value = 0 Then
            Col = Col + 1
            If Max_ < Col Then Max_ = Col
            If Max_ > Num - 1 Then Exit For   '*'
        Else
            Col = 0
        End If
    Next wW
    If Max_ <> Num - 1 Then                   '*'
        Set zRg = Union(zRg, Cells(Jj, 1).Resize(4))
    End If
    Max_ = 0:                               Col = 0
 Next Jj
 zRg.EntireRow.Delete:                      [A1].Value = "GPE"
 [B1].Value = Timer - Timer_
End Sub
 
All in one

Tôi viết chung tất cả trong một code. Bạn có thể nhập số dòng cần ghép và điều kiện ghép (Số cột rỗng liên tiếp).
Khi chạy code sẽ hiện lên 2 cái InputBox.
InputBox đầu: Nhập số dòng cần ghép. Từ 2 đến 5 dòng thôi nhé. Số dòng càng nhiều thì xử lý càng lâu.
InputBox sau: Nhập số cột rỗng làm điều kiện. Lớn hơn 0.
Tốc độ tương đối ổn. Bạn tải về thêm dữ liệu vào rồi test thử xem sao.
PHP: 
Sub GPE()
Dim i As Long, Dong1 As Long, Dong2 As Long, Dong3 As Long, Dong4 As Long, Dong5 As Long
Dim SoDong As Long, SoCot As Long
Dim EndR As Long, EndC As String
Dim StartR As Long, StartC As String
Dim Nm As Names
On Error Resume Next
StartR = 4
StartC = "B"
EndR = Sheet1.Cells(Sheet1.Rows.Count, 1).End(xlUp).Row
EndC = Replace(Sheet1.Cells(1, Sheet1.Columns.Count).End(xlToLeft).Address(0, 0), "1", "")
For i = 1 To 5
    ActiveWorkbook.Names("RngDong" & i).Delete
Next
Sheet7.Cells.ClearContents
SoDong = InputBox("Nhap so dong can ghep" & vbNewLine & "2 <= [So dong ghep] <= 5")
SoCot = InputBox("Nhap so cot rong toi da" & vbNewLine & "[So cot rong] > 0")
For i = 1 To SoDong
    ActiveWorkbook.Names.Add Name:="RngDong" & i, RefersTo:=0
Next
    ActiveWorkbook.Names.Add Name:="Ghep", RefersTo:="=RngDong1+RngDong2" & IIf(SoDong >= 3, "+RngDong3", "") & IIf(SoDong >= 4, "+RngDong4", "") & IIf(SoDong >= 5, "+RngDong5", "")
For Dong1 = StartR To EndR
    ActiveWorkbook.Names("RngDong1").RefersTo = "='" & Sheet1.Name & "'!$" & StartC & "$" & Dong1 & ":$" & EndC & "$" & Dong1
    If Application.WorksheetFunction.Sum([RngDong1].Resize(, SoCot)) = 0 Then
        For Dong2 = Dong1 + 1 To EndR
            ActiveWorkbook.Names("RngDong2").RefersTo = "='" & Sheet1.Name & "'!$" & StartC & "$" & Dong2 & ":$" & EndC & "$" & Dong2
            If Application.WorksheetFunction.Sum([RngDong2].Resize(, SoCot)) = 0 Then
                If SoDong > 2 Then
                    For Dong3 = Dong2 + 1 To EndR
                        ActiveWorkbook.Names("RngDong3").RefersTo = "='" & Sheet1.Name & "'!$" & StartC & "$" & Dong3 & ":$" & EndC & "$" & Dong3
                        If Application.WorksheetFunction.Sum([RngDong3].Resize(, SoCot)) = 0 Then
                            If SoDong > 3 Then
                                For Dong4 = Dong3 + 1 To EndR
                                    ActiveWorkbook.Names("RngDong4").RefersTo = "='" & Sheet1.Name & "'!$" & StartC & "$" & Dong4 & ":$" & EndC & "$" & Dong4
                                    If Application.WorksheetFunction.Sum([RngDong4].Resize(, SoCot)) = 0 Then
                                        If SoDong = 5 Then
                                            For Dong5 = Dong4 + 1 To EndR
                                                ActiveWorkbook.Names("RngDong5").RefersTo = "='" & Sheet1.Name & "'!$" & StartC & "$" & Dong5 & ":$" & EndC & "$" & Dong5
                                                If Application.WorksheetFunction.Sum([RngDong5].Resize(, SoCot)) = 0 Then
                                                    Call KiemTra(SoCot, SoDong)
                                                End If
                                            Next
                                        ElseIf SoDong = 4 Then
                                            Call KiemTra(SoCot, SoDong)
                                        End If
                                    End If
                                Next
                            ElseIf SoDong = 3 Then
                                Call KiemTra(SoCot, SoDong)
                            End If
                        End If
                    Next
                ElseIf SoDong = 2 Then
                    Call KiemTra(SoCot, SoDong)
                End If
            End If
        Next
    End If
Next
End Sub
PHP: 
Sub KiemTra(CotRong As Long, DongGhep As Long)
    Dim StrGhep As String, k As Long, Sh As Worksheet
    Set ShKetQua = Sheet7
    StrGhep = "-" & Join(Application.WorksheetFunction.Transpose(Application.WorksheetFunction.Transpose([Ghep])), "-") & "-"
    StrGhep = Right(StrGhep, Len(LTrim(Replace(StrGhep, "-0", "  "))))
        If InStr(StrGhep, Replace(Space(CotRong + 1), " ", "-0") & "-") = 0 And InStr(StrGhep, Replace(Space(CotRong), " ", "-0") & "-") > 0 Then
            ShKetQua.Cells(Sheet1.Rows.Count, 1).End(xlUp).Offset(1).Value = "------------------------------------------------"
            For k = 1 To DongGhep
                ShKetQua.Cells(Sheet1.Rows.Count, 1).End(xlUp).Offset(1).Resize(, Range("RngDong" & k).Columns.Count + 1).Value = Range("RngDong" & k).Offset(0, -1).Resize(, Range("RngDong" & k).Columns.Count + 1).Value
            Next
        End If
End Sub
 

File đính kèm

huuthang_bd đã viết:
Tôi viết chung tất cả trong một code. Bạn có thể nhập số dòng cần ghép và điều kiện ghép (Số cột rỗng liên tiếp).
Khi chạy code sẽ hiện lên 2 cái InputBox.
InputBox đầu: Nhập số dòng cần ghép. Từ 2 đến 5 dòng thôi nhé. Số dòng càng nhiều thì xử lý càng lâu.
InputBox sau: Nhập số cột rỗng làm điều kiện. Lớn hơn 0.
Tốc độ tương đối ổn. Bạn tải về thêm dữ liệu vào rồi test thử xem sao.
PHP: 
Sub GPE()
Dim i As Long, Dong1 As Long, Dong2 As Long, Dong3 As Long, Dong4 As Long, Dong5 As Long
Dim SoDong As Long, SoCot As Long
Dim EndR As Long, EndC As String
Dim StartR As Long, StartC As String
Dim Nm As Names
On Error Resume Next
StartR = 4
StartC = "B"
EndR = Sheet1.Cells(Sheet1.Rows.Count, 1).End(xlUp).Row
EndC = Replace(Sheet1.Cells(1, Sheet1.Columns.Count).End(xlToLeft).Address(0, 0), "1", "")
For i = 1 To 5
    ActiveWorkbook.Names("RngDong" & i).Delete
Next
Sheet7.Cells.ClearContents
SoDong = InputBox("Nhap so dong can ghep" & vbNewLine & "2 <= [So dong ghep] <= 5")
SoCot = InputBox("Nhap so cot rong toi da" & vbNewLine & "[So cot rong] > 0")
For i = 1 To SoDong
    ActiveWorkbook.Names.Add Name:="RngDong" & i, RefersTo:=0
Next
    ActiveWorkbook.Names.Add Name:="Ghep", RefersTo:="=RngDong1+RngDong2" & IIf(SoDong >= 3, "+RngDong3", "") & IIf(SoDong >= 4, "+RngDong4", "") & IIf(SoDong >= 5, "+RngDong5", "")
For Dong1 = StartR To EndR
    ActiveWorkbook.Names("RngDong1").RefersTo = "='" & Sheet1.Name & "'!$" & StartC & "$" & Dong1 & ":$" & EndC & "$" & Dong1
    If Application.WorksheetFunction.Sum([RngDong1].Resize(, SoCot)) = 0 Then
        For Dong2 = Dong1 + 1 To EndR
            ActiveWorkbook.Names("RngDong2").RefersTo = "='" & Sheet1.Name & "'!$" & StartC & "$" & Dong2 & ":$" & EndC & "$" & Dong2
            If Application.WorksheetFunction.Sum([RngDong2].Resize(, SoCot)) = 0 Then
                If SoDong > 2 Then
                    For Dong3 = Dong2 + 1 To EndR
                        ActiveWorkbook.Names("RngDong3").RefersTo = "='" & Sheet1.Name & "'!$" & StartC & "$" & Dong3 & ":$" & EndC & "$" & Dong3
                        If Application.WorksheetFunction.Sum([RngDong3].Resize(, SoCot)) = 0 Then
                            If SoDong > 3 Then
                                For Dong4 = Dong3 + 1 To EndR
                                    ActiveWorkbook.Names("RngDong4").RefersTo = "='" & Sheet1.Name & "'!$" & StartC & "$" & Dong4 & ":$" & EndC & "$" & Dong4
                                    If Application.WorksheetFunction.Sum([RngDong4].Resize(, SoCot)) = 0 Then
                                        If SoDong = 5 Then
                                            For Dong5 = Dong4 + 1 To EndR
                                                ActiveWorkbook.Names("RngDong5").RefersTo = "='" & Sheet1.Name & "'!$" & StartC & "$" & Dong5 & ":$" & EndC & "$" & Dong5
                                                If Application.WorksheetFunction.Sum([RngDong5].Resize(, SoCot)) = 0 Then
                                                    Call KiemTra(SoCot, SoDong)
                                                End If
                                            Next
                                        ElseIf SoDong = 4 Then
                                            Call KiemTra(SoCot, SoDong)
                                        End If
                                    End If
                                Next
                            ElseIf SoDong = 3 Then
                                Call KiemTra(SoCot, SoDong)
                            End If
                        End If
                    Next
                ElseIf SoDong = 2 Then
                    Call KiemTra(SoCot, SoDong)
                End If
            End If
        Next
    End If
Next
End Sub
PHP: 
Sub KiemTra(CotRong As Long, DongGhep As Long)
    Dim StrGhep As String, k As Long, Sh As Worksheet
    Set ShKetQua = Sheet7
    StrGhep = "-" & Join(Application.WorksheetFunction.Transpose(Application.WorksheetFunction.Transpose([Ghep])), "-") & "-"
    StrGhep = Right(StrGhep, Len(LTrim(Replace(StrGhep, "-0", "  "))))
        If InStr(StrGhep, Replace(Space(CotRong + 1), " ", "-0") & "-") = 0 And InStr(StrGhep, Replace(Space(CotRong), " ", "-0") & "-") > 0 Then
            ShKetQua.Cells(Sheet1.Rows.Count, 1).End(xlUp).Offset(1).Value = "------------------------------------------------"
            For k = 1 To DongGhep
                ShKetQua.Cells(Sheet1.Rows.Count, 1).End(xlUp).Offset(1).Resize(, Range("RngDong" & k).Columns.Count + 1).Value = Range("RngDong" & k).Offset(0, -1).Resize(, Range("RngDong" & k).Columns.Count + 1).Value
            Next
        End If
End Sub
Nhấp chuột vào đây để mở rộng...
Híc, Mình đang ngồi chiêm ngưỡng tác phẩm của bạn! (Bao giờ mình có thể làm được như vậy nhỉ?)
- Cảm ơn bạn nhiều quá! Mình sẽ test thử với dữ liệu nhiều hơn xem sao!
- Chúc bạn luôn gặp nhiều may mắn! Cảm ơn GPE!
 
Hãy giành ra 8 fút để chạy thử 2.000 dòng dữ liệu giả lập này

--=0
--=0 --=0
--=0 @!## --=0
--=0 --=0
--=0

​
 

File đính kèm

ChanhTQ@ đã viết:
--=0
--=0 --=0
--=0 @!## --=0
--=0 --=0
--=0

​
Nhấp chuột vào đây để mở rộng...
Cáo ơn Bác Sa nhiều, với dạng bài này e có làm thử nhưng với kết quả gần 800.000 dòng thì chẳng Ex nào mà lưu nổi cả.
Chắc tác giả nếu hết yêu cầu 1 lượt rối kiếm phần mềm nào mà lưu nổi dạng ADO lưu qua Acc họa may.
File lớn quá nên cũng chả có kiên nhẫn test, mà test ít dòng thì chưa chắc là hoàn thiện vì data quá lớn.
 
ChanhTQ@ đã viết:
--=0​


--=0 --=0
--=0 @!## --=0
--=0 --=0
--=0​
Nhấp chuột vào đây để mở rộng...

Vâng! Cảm ơn bạn! Đúng là tốc độ như vậy rất tuyệt bạn ChanhTQ ạ!
- Nếu mình muốn test thử với n dòng dữ liệu thì mình sẽ chỉnh đoạn code ở thông số nào ạ? (ví dụ mình muốn test với 11345 dòng dữ liệu chẳng hạn?)
- Cảm ơn bạn rất nhiều! Mong tin bạn rất nhiều!
Option Explicit
Sub Ghep3Dong()
Dim Nomer As Byte

Nomer = InputBox("Hay Nhap So Tri: ", "GPE Xin Luu Y: < 11", "5")
GPE Nomer
End Sub
Sub GPE(Num)
Dim Rws As Long, Col As Integer, jJ As Long, wW As Long, zZ As Long, Ff As Integer
Dim jRg As Range, wRg As Range, zRg As Range, WF As Object, Sh As Worksheet
Dim Max_ As Byte, Timer_ As Double, Tong As Long
Const Ct As Integer = 398

Timer_ = Timer: Sheets("S2").Select
Rws = [A65535].End(xlUp).Row: Set Sh = Sheets("S5") '<=|'
Sh.Range(Sh.[A1], Sh.[A65500].End(xlUp)).Resize(, Ct).Clear:
Set WF = Application.WorksheetFunction
For jJ = 4 To Rws - 2
Set jRg = Range(Cells(jJ, "B"), Cells(jJ, "OH"))
Set jRg = Cells(jJ, "B").Resize(, Ct - 2)
If WF.Sum(jRg(1).Resize(, Num)) = 0 Then
For wW = jJ + 1 To Rws - 1
Set wRg = Cells(wW, "B").Resize(, Ct - 2)
If WF.Sum(wRg(1).Resize(, Num)) = 0 Then
For zZ = wW + 1 To Rws
Set zRg = Cells(zZ, "B").Resize(, Ct - 2)
If WF.Sum(zRg(1).Resize(, Num)) = 0 Then
With Sh.[A65500].End(xlUp).Offset(2)
If .Row > 65500 Then GoTo 999
.Resize(, Ct).Value = jRg(0).Resize(, Ct).Value
.Offset(1).Resize(, Ct).Value = wRg(0).Resize(, Ct).Value
.Offset(2).Resize(, Ct).Value = zRg(0).Resize(, Ct).Value
End With
End If
Next zZ
End If
Next wW
End If
Next jJ
999
Sh.Select: Set Sh = Nothing
[c2].Value = Timer - Timer_: Set jRg = Nothing
Rws = [A65500].End(xlUp).Row + 1: Set wRg = Nothing
Set zRg = [A1]
For jJ = 3 To Rws Step 4
Cells(jJ, 1).Interior.ColorIndex = 34 + jJ Mod 9
For wW = (Num + 2) To Ct
Tong = WF.Sum(Cells(jJ, wW).Resize(3))
If Tong = 0 Then
If WF.Sum(Cells(jJ, wW - 1).Resize(3)) = 0 Then
Col = Col + 1
If Max_ < Col Then Max_ = Col
If Max_ > Num - 1 Then Exit For
End If
Else
Col = 0
End If
Next wW
If Max_ <> Num - 1 Then
Set zRg = Union(zRg, Cells(jJ, 1).Resize(4))
End If
Max_ = 0: Col = 0
Next jJ
[d2] = zRg.Count - 1
zRg.EntireRow.Delete: [A1].Value = "GPE"
[B1].Value = Timer - Timer_
End Sub
Nhấp chuột vào đây để mở rộng...
 
Lần chỉnh sửa cuối:
If .Row > 65500 Then GoTo 999

Bạn thấy dòng lệnh này không?

Thực ra, nếu bạn xem kết quả tại 'S5' sẽ thấy nó thể hiện 1 fần nhỏ nhoi kết quả của quá trình mà thôi (Vì hàng đầu của 3 dòng cuối kết quả vẫn còn mang mã A04.) (& nếu bạn đủ kiên nhẫn, bạn có thể tăng số này lên gấp đôi, gấp 3 hay hơn nữa xem sao; Vì mình chỉ có E2003 mà!)

Bổ sung:
ví dụ mình muốn test với 11345 dòng dữ liệu chẳng hạn?
Nhấp chuột vào đây để mở rộng...
Ngoài ra ta còn fải đổi các con số 65500 hay 65535 thành những con số lớn hơn 1 cách tương ứng thích hợp nữa đó bạn

Thân ái!
 
Chỉnh sửa lần cuối bởi điều hành viên:
Không biết lỗi chỗ nào mà code của bác ChanhTQ nhiều khi cho kết quả không đúng. Như trong file dữ liệu tôi gửi kèm, 3 dòng đầu không thỏa điều kiện nhưng code lại ghép thành 1 kết quả, 3 dòng sau thỏa điều kiện như code không ghép lại.

Tôi sửa lại code của tôi một chút, không ghi dữ liệu trực tiếp vào file mà gán vào mảng trước rồi mới ghi vào file. Đương nhiên cách này tốc độ sẽ nhanh hơn cách trước.
 

File đính kèm

huuthang_bd đã viết:
Không biết lỗi chỗ nào mà code của bác ChanhTQ nhiều khi cho kết quả không đúng. Như trong file dữ liệu tôi gửi kèm, 3 dòng đầu không thỏa điều kiện nhưng code lại ghép thành 1 kết quả, 3 dòng sau thỏa điều kiện như code không ghép lại.

Tôi sửa lại code của tôi một chút, không ghi dữ liệu trực tiếp vào file mà gán vào mảng trước rồi mới ghi vào file. Đương nhiên cách này tốc độ sẽ nhanh hơn cách trước.
Nhấp chuột vào đây để mở rộng...

Vâng! Tuyệt quá bạn à! Hoàn hảo! Cảm ơn bạn rất nhiều!

huuthang_bd đã viết:
Tôi sửa lại code của tôi một chút, không ghi dữ liệu trực tiếp vào file mà gán vào mảng trước rồi mới ghi vào file. Đương nhiên cách này tốc độ sẽ nhanh hơn cách trước.
Nhấp chuột vào đây để mở rộng...

Bạn Huuthang_bd ơi! Bạn có thể xem giúp mình trường hợp này được không? Mình thấy cách của bạn rất hay và hợp lí! Mong bạn giúp đỡ! Mong GPE cùng xem hộ giúp trường hợp này ạ! Chân thành cảm ơn! Thân ái!
 

File đính kèm

Chỉnh sửa lần cuối bởi điều hành viên:
pt_hcl đã viết:
Vâng! Tuyệt quá bạn à! Hoàn hảo! Cảm ơn bạn rất nhiều!



Bạn Huuthang_bd ơi! Bạn có thể xem giúp mình trường hợp này được không? Mình thấy cách của bạn rất hay và hợp lí! Mong bạn giúp đỡ! Mong GPE cùng xem hộ giúp trường hợp này ạ! Chân thành cảm ơn! Thân ái!
Nhấp chuột vào đây để mở rộng...
Bạn test thử xem có bị lỗi gì không nhé.
 

File đính kèm

hỏi các bác 1 một chút

hỏi các bác 1 chút

Các bác cho em hỏi chút nhá
Em lưu giữ liệu vào ổ D nhưng cùng lúc đó giữ liệu cũng lưu vào my document. Bây giờ em ko muốn lưu như thế thì làm thế nào ah?Tức là mình lưu vào ổ nào thì dữ liệu chỉ lưu vào ổ đó thôi
Mng các bác giúp đỡ em.
Cang nhanh càng tôt các bác nhá
Em cảm ơn các bác!
 
Lần chỉnh sửa cuối:
Sửa lại code theo yêu cầu của chủ Topic.
PHP: 
Sub GPE()
Application.ScreenUpdating = False
Dim i As Long, Dong1 As Long, Dong2 As Long, Dong3 As Long, Dong4 As Long, Dong5 As Long
Dim SoDong As Long, SoCot As Long
Dim EndR As Long, EndC As String
Dim StartR As Long, StartC As String
Dim Nm As Names
Dim Arr() As String, ViTri As Long
ReDim Arr(1 To Sheet1.Rows.Count, 1 To 1)
On Error Resume Next
StartR = 4
StartC = "B"
EndR = Sheet1.Cells(Sheet1.Rows.Count, 1).End(xlUp).Row
EndC = Replace(Sheet1.Cells(1, Sheet1.Columns.Count).End(xlToLeft).Address(0, 0), "1", "")
For i = 1 To 5
    ActiveWorkbook.Names("RngDong" & i).Delete
Next
Sheet7.Cells.ClearContents
SoDong = InputBox("Nhap so dong can ghep" & vbNewLine & "2 <= [So dong ghep] <= 5")
SoCot = InputBox("Nhap so cot rong toi da" & vbNewLine & "[So cot rong] > 0")
For i = 1 To SoDong
    ActiveWorkbook.Names.Add Name:="RngDong" & i, RefersTo:=0
Next
    ActiveWorkbook.Names.Add Name:="Ghep", RefersTo:="=RngDong1+RngDong2" & IIf(SoDong >= 3, "+RngDong3", "") & IIf(SoDong >= 4, "+RngDong4", "") & IIf(SoDong >= 5, "+RngDong5", "")
For Dong1 = StartR To EndR
    ActiveWorkbook.Names("RngDong1").RefersTo = "='" & Sheet1.Name & "'!$" & StartC & "$" & Dong1 & ":$" & EndC & "$" & Dong1
    For Dong2 = Dong1 + 1 To EndR
        If ViTri = Sheet1.Rows.Count Then GoTo HetDong
        ActiveWorkbook.Names("RngDong2").RefersTo = "='" & Sheet1.Name & "'!$" & StartC & "$" & Dong2 & ":$" & EndC & "$" & Dong2
        If SoDong > 2 Then
            For Dong3 = Dong2 + 1 To EndR
                If ViTri = Sheet1.Rows.Count Then GoTo HetDong
                ActiveWorkbook.Names("RngDong3").RefersTo = "='" & Sheet1.Name & "'!$" & StartC & "$" & Dong3 & ":$" & EndC & "$" & Dong3
                    If SoDong > 3 Then
                        For Dong4 = Dong3 + 1 To EndR
                            If ViTri = Sheet1.Rows.Count Then GoTo HetDong
                            ActiveWorkbook.Names("RngDong4").RefersTo = "='" & Sheet1.Name & "'!$" & StartC & "$" & Dong4 & ":$" & EndC & "$" & Dong4
                                If SoDong = 5 Then
                                    For Dong5 = Dong4 + 1 To EndR
                                        If ViTri = Sheet1.Rows.Count Then GoTo HetDong
                                        ActiveWorkbook.Names("RngDong5").RefersTo = "='" & Sheet1.Name & "'!$" & StartC & "$" & Dong5 & ":$" & EndC & "$" & Dong5
                                            If KiemTra(SoCot, SoDong) Then
                                                ViTri = ViTri + 1
                                                Arr(ViTri, 1) = ""
                                                For i = 1 To SoDong
                                                    ViTri = ViTri + 1
                                                    Arr(ViTri, 1) = Join(Application.WorksheetFunction.Transpose(Application.WorksheetFunction.Transpose(Range("RngDong" & i).Offset(0, -1).Resize(, Range("RngDong" & i).Columns.Count + 1))), "-")
                                                Next
                                            End If
                                    Next
                                ElseIf SoDong = 4 Then
                                    If KiemTra(SoCot, SoDong) Then
                                        ViTri = ViTri + 1
                                        Arr(ViTri, 1) = ""
                                        For i = 1 To SoDong
                                            ViTri = ViTri + 1
                                            Arr(ViTri, 1) = Join(Application.WorksheetFunction.Transpose(Application.WorksheetFunction.Transpose(Range("RngDong" & i).Offset(0, -1).Resize(, Range("RngDong" & i).Columns.Count + 1))), "-")
                                        Next
                                    End If
                                End If
                        Next
                    ElseIf SoDong = 3 Then
                        If KiemTra(SoCot, SoDong) Then
                            ViTri = ViTri + 1
                            Arr(ViTri, 1) = ""
                            For i = 1 To SoDong
                                ViTri = ViTri + 1
                                Arr(ViTri, 1) = Join(Application.WorksheetFunction.Transpose(Application.WorksheetFunction.Transpose(Range("RngDong" & i).Offset(0, -1).Resize(, Range("RngDong" & i).Columns.Count + 1))), "-")
                            Next
                        End If
                    End If
            Next
        ElseIf SoDong = 2 Then
            If KiemTra(SoCot, SoDong) Then
                ViTri = ViTri + 1
                Arr(ViTri, 1) = ""
                For i = 1 To SoDong
                    ViTri = ViTri + 1
                    Arr(ViTri, 1) = Join(Application.WorksheetFunction.Transpose(Application.WorksheetFunction.Transpose(Range("RngDong" & i).Offset(0, -1).Resize(, Range("RngDong" & i).Columns.Count + 1))), "-")
                Next
            End If
        End If
    Next
Next
HetDong:
Sheet7.Range("A1:A" & Application.WorksheetFunction.Min(ViTri, Sheet1.Rows.Count)).Value = Arr
Range(Sheet7.[A1], Sheet7.[A65536].End(xlUp)).TextToColumns [A1], 1, , , 1, , , , 1, "-"
Application.ScreenUpdating = True
End Sub
PHP: 
Private Function KiemTra(CotRong As Long, DongGhep As Long) As Boolean
    Dim StrGhep As String
    StrGhep = "-" & Join(Application.WorksheetFunction.Transpose(Application.WorksheetFunction.Transpose([Ghep])), "-") & "-"
    StrGhep = Right(StrGhep, Len(LTrim(Replace(StrGhep, "-0", "  "))))
    KiemTra = InStr(StrGhep, Replace(Space(CotRong + 1), " ", "-0") & "-") = 0 And InStr(StrGhep, Replace(Space(CotRong), " ", "-0") & "-") > 0
End Function
 

File đính kèm

huuthang_bd đã viết:
Sửa lại code theo yêu cầu của chủ Topic.
PHP: 
Sub GPE()
Application.ScreenUpdating = False
Dim i As Long, Dong1 As Long, Dong2 As Long, Dong3 As Long, Dong4 As Long, Dong5 As Long
Dim SoDong As Long, SoCot As Long
Dim EndR As Long, EndC As String
Dim StartR As Long, StartC As String
Dim Nm As Names
Dim Arr() As String, ViTri As Long
ReDim Arr(1 To Sheet1.Rows.Count, 1 To 1)
On Error Resume Next
StartR = 4
StartC = "B"
EndR = Sheet1.Cells(Sheet1.Rows.Count, 1).End(xlUp).Row
EndC = Replace(Sheet1.Cells(1, Sheet1.Columns.Count).End(xlToLeft).Address(0, 0), "1", "")
For i = 1 To 5
ActiveWorkbook.Names("RngDong" & i).Delete
Next
Sheet7.Cells.ClearContents
SoDong = InputBox("Nhap so dong can ghep" & vbNewLine & "2 <= [So dong ghep] <= 5")
SoCot = InputBox("Nhap so cot rong toi da" & vbNewLine & "[So cot rong] > 0")
For i = 1 To SoDong
ActiveWorkbook.Names.Add Name:="RngDong" & i, RefersTo:=0
Next
ActiveWorkbook.Names.Add Name:="Ghep", RefersTo:="=RngDong1+RngDong2" & IIf(SoDong >= 3, "+RngDong3", "") & IIf(SoDong >= 4, "+RngDong4", "") & IIf(SoDong >= 5, "+RngDong5", "")
For Dong1 = StartR To EndR
ActiveWorkbook.Names("RngDong1").RefersTo = "='" & Sheet1.Name & "'!$" & StartC & "$" & Dong1 & ":$" & EndC & "$" & Dong1
For Dong2 = Dong1 + 1 To EndR
If ViTri = Sheet1.Rows.Count Then GoTo HetDong
ActiveWorkbook.Names("RngDong2").RefersTo = "='" & Sheet1.Name & "'!$" & StartC & "$" & Dong2 & ":$" & EndC & "$" & Dong2
If SoDong > 2 Then
For Dong3 = Dong2 + 1 To EndR
If ViTri = Sheet1.Rows.Count Then GoTo HetDong
ActiveWorkbook.Names("RngDong3").RefersTo = "='" & Sheet1.Name & "'!$" & StartC & "$" & Dong3 & ":$" & EndC & "$" & Dong3
If SoDong > 3 Then
For Dong4 = Dong3 + 1 To EndR
If ViTri = Sheet1.Rows.Count Then GoTo HetDong
ActiveWorkbook.Names("RngDong4").RefersTo = "='" & Sheet1.Name & "'!$" & StartC & "$" & Dong4 & ":$" & EndC & "$" & Dong4
If SoDong = 5 Then
For Dong5 = Dong4 + 1 To EndR
If ViTri = Sheet1.Rows.Count Then GoTo HetDong
ActiveWorkbook.Names("RngDong5").RefersTo = "='" & Sheet1.Name & "'!$" & StartC & "$" & Dong5 & ":$" & EndC & "$" & Dong5
If KiemTra(SoCot, SoDong) Then
ViTri = ViTri + 1
Arr(ViTri, 1) = ""
For i = 1 To SoDong
ViTri = ViTri + 1
Arr(ViTri, 1) = Join(Application.WorksheetFunction.Transpose(Application.WorksheetFunction.Transpose(Range("RngDong" & i).Offset(0, -1).Resize(, Range("RngDong" & i).Columns.Count + 1))), "-")
Next
End If
Next
ElseIf SoDong = 4 Then
If KiemTra(SoCot, SoDong) Then
ViTri = ViTri + 1
Arr(ViTri, 1) = ""
For i = 1 To SoDong
ViTri = ViTri + 1
Arr(ViTri, 1) = Join(Application.WorksheetFunction.Transpose(Application.WorksheetFunction.Transpose(Range("RngDong" & i).Offset(0, -1).Resize(, Range("RngDong" & i).Columns.Count + 1))), "-")
Next
End If
End If
Next
ElseIf SoDong = 3 Then
If KiemTra(SoCot, SoDong) Then
ViTri = ViTri + 1
Arr(ViTri, 1) = ""
For i = 1 To SoDong
ViTri = ViTri + 1
Arr(ViTri, 1) = Join(Application.WorksheetFunction.Transpose(Application.WorksheetFunction.Transpose(Range("RngDong" & i).Offset(0, -1).Resize(, Range("RngDong" & i).Columns.Count + 1))), "-")
Next
End If
End If
Next
ElseIf SoDong = 2 Then
If KiemTra(SoCot, SoDong) Then
ViTri = ViTri + 1
Arr(ViTri, 1) = ""
For i = 1 To SoDong
ViTri = ViTri + 1
Arr(ViTri, 1) = Join(Application.WorksheetFunction.Transpose(Application.WorksheetFunction.Transpose(Range("RngDong" & i).Offset(0, -1).Resize(, Range("RngDong" & i).Columns.Count + 1))), "-")
Next
End If
End If
Next
Next
HetDong:
Sheet7.Range("A1:A" & Application.WorksheetFunction.Min(ViTri, Sheet1.Rows.Count)).Value = Arr
Range(Sheet7.[A1], Sheet7.[A65536].End(xlUp)).TextToColumns [A1], 1, , , 1, , , , 1, "-"
Application.ScreenUpdating = True
End Sub
PHP: 
Private Function KiemTra(CotRong As Long, DongGhep As Long) As Boolean
Dim StrGhep As String
StrGhep = "-" & Join(Application.WorksheetFunction.Transpose(Application.WorksheetFunction.Transpose([Ghep])), "-") & "-"
StrGhep = Right(StrGhep, Len(LTrim(Replace(StrGhep, "-0", " "))))
KiemTra = InStr(StrGhep, Replace(Space(CotRong + 1), " ", "-0") & "-") = 0 And InStr(StrGhep, Replace(Space(CotRong), " ", "-0") & "-") > 0
End Function
Nhấp chuột vào đây để mở rộng...

Thân gửi bạn Huuthang_bd và các bạn trong GPE!
* Rất mong bạn Huuthang và các bạn trong diễn đàn GPE chỉ giúp mình chỗ sửa lại đoạn code này một chút cho phù hợp với điều kiện mới của bài toán:
- Nếu Ở bài toán cũ là ghép với 2 dòng, 3 dòng, 4 dòng, và 5 dòng với số cột rỗng tùy ý mình nhập, theo cách sử lí như vậy là rất hay, rất tuyệt vời rồi ạ! Bây giờ mình muốn mình muốn ghép với 50 dòng, 60 dòng, 70 dòng, 80 dòng, 90 dòng lại với nhau thì mình sửa như thế nào ạ? (mình đã mày mò tự sửa mất gần 1 tháng nay mà chưa ra, đành phải làm phiền các bạn)
- Nếu các bạn chỉ cho mình chỗ sửa cụ thể cho một trường hợp (ví dụ ghép 50 dòng chẳng hạn) thì tốt quá, mình sẽ bắt chước sửa cho trường hợp còn lại! Nếu có thể các bạn có thể làm giúp mình tất các trường hợp rùi mình tự mày mò đối chiếu với cái cũ để tìm ra chỗ sửa được không ạ!
- Một lần nữa rất mong các bạn giúp đỡ! Xin chân thành cảm ơn các bạn! Từng giây chờ sự giúp đỡ! Thân ái!
- Nếu có thể mong các bạn có thể áp vào file này được không ạ?
 

File đính kèm

huuthang_bd đã viết:
Sửa lại code theo yêu cầu của chủ Topic.
PHP: 
Sub GPE()
Application.ScreenUpdating = False
Dim i As Long, Dong1 As Long, Dong2 As Long, Dong3 As Long, Dong4 As Long, Dong5 As Long
Dim SoDong As Long, SoCot As Long
Dim EndR As Long, EndC As String
Dim StartR As Long, StartC As String
Dim Nm As Names
Dim Arr() As String, ViTri As Long
ReDim Arr(1 To Sheet1.Rows.Count, 1 To 1)
On Error Resume Next
StartR = 4
StartC = "B"
EndR = Sheet1.Cells(Sheet1.Rows.Count, 1).End(xlUp).Row
EndC = Replace(Sheet1.Cells(1, Sheet1.Columns.Count).End(xlToLeft).Address(0, 0), "1", "")
For i = 1 To 5
ActiveWorkbook.Names("RngDong" & i).Delete
Next
Sheet7.Cells.ClearContents
SoDong = InputBox("Nhap so dong can ghep" & vbNewLine & "2 <= [So dong ghep] <= 5")
SoCot = InputBox("Nhap so cot rong toi da" & vbNewLine & "[So cot rong] > 0")
For i = 1 To SoDong
ActiveWorkbook.Names.Add Name:="RngDong" & i, RefersTo:=0
Next
ActiveWorkbook.Names.Add Name:="Ghep", RefersTo:="=RngDong1+RngDong2" & IIf(SoDong >= 3, "+RngDong3", "") & IIf(SoDong >= 4, "+RngDong4", "") & IIf(SoDong >= 5, "+RngDong5", "")
For Dong1 = StartR To EndR
ActiveWorkbook.Names("RngDong1").RefersTo = "='" & Sheet1.Name & "'!$" & StartC & "$" & Dong1 & ":$" & EndC & "$" & Dong1
For Dong2 = Dong1 + 1 To EndR
If ViTri = Sheet1.Rows.Count Then GoTo HetDong
ActiveWorkbook.Names("RngDong2").RefersTo = "='" & Sheet1.Name & "'!$" & StartC & "$" & Dong2 & ":$" & EndC & "$" & Dong2
If SoDong > 2 Then
For Dong3 = Dong2 + 1 To EndR
If ViTri = Sheet1.Rows.Count Then GoTo HetDong
ActiveWorkbook.Names("RngDong3").RefersTo = "='" & Sheet1.Name & "'!$" & StartC & "$" & Dong3 & ":$" & EndC & "$" & Dong3
If SoDong > 3 Then
For Dong4 = Dong3 + 1 To EndR
If ViTri = Sheet1.Rows.Count Then GoTo HetDong
ActiveWorkbook.Names("RngDong4").RefersTo = "='" & Sheet1.Name & "'!$" & StartC & "$" & Dong4 & ":$" & EndC & "$" & Dong4
If SoDong = 5 Then
For Dong5 = Dong4 + 1 To EndR
If ViTri = Sheet1.Rows.Count Then GoTo HetDong
ActiveWorkbook.Names("RngDong5").RefersTo = "='" & Sheet1.Name & "'!$" & StartC & "$" & Dong5 & ":$" & EndC & "$" & Dong5
If KiemTra(SoCot, SoDong) Then
ViTri = ViTri + 1
Arr(ViTri, 1) = ""
For i = 1 To SoDong
ViTri = ViTri + 1
Arr(ViTri, 1) = Join(Application.WorksheetFunction.Transpose(Application.WorksheetFunction.Transpose(Range("RngDong" & i).Offset(0, -1).Resize(, Range("RngDong" & i).Columns.Count + 1))), "-")
Next
End If
Next
ElseIf SoDong = 4 Then
If KiemTra(SoCot, SoDong) Then
ViTri = ViTri + 1
Arr(ViTri, 1) = ""
For i = 1 To SoDong
ViTri = ViTri + 1
Arr(ViTri, 1) = Join(Application.WorksheetFunction.Transpose(Application.WorksheetFunction.Transpose(Range("RngDong" & i).Offset(0, -1).Resize(, Range("RngDong" & i).Columns.Count + 1))), "-")
Next
End If
End If
Next
ElseIf SoDong = 3 Then
If KiemTra(SoCot, SoDong) Then
ViTri = ViTri + 1
Arr(ViTri, 1) = ""
For i = 1 To SoDong
ViTri = ViTri + 1
Arr(ViTri, 1) = Join(Application.WorksheetFunction.Transpose(Application.WorksheetFunction.Transpose(Range("RngDong" & i).Offset(0, -1).Resize(, Range("RngDong" & i).Columns.Count + 1))), "-")
Next
End If
End If
Next
ElseIf SoDong = 2 Then
If KiemTra(SoCot, SoDong) Then
ViTri = ViTri + 1
Arr(ViTri, 1) = ""
For i = 1 To SoDong
ViTri = ViTri + 1
Arr(ViTri, 1) = Join(Application.WorksheetFunction.Transpose(Application.WorksheetFunction.Transpose(Range("RngDong" & i).Offset(0, -1).Resize(, Range("RngDong" & i).Columns.Count + 1))), "-")
Next
End If
End If
Next
Next
HetDong:
Sheet7.Range("A1:A" & Application.WorksheetFunction.Min(ViTri, Sheet1.Rows.Count)).Value = Arr
Range(Sheet7.[A1], Sheet7.[A65536].End(xlUp)).TextToColumns [A1], 1, , , 1, , , , 1, "-"
Application.ScreenUpdating = True
End Sub
PHP: 
Private Function KiemTra(CotRong As Long, DongGhep As Long) As Boolean
Dim StrGhep As String
StrGhep = "-" & Join(Application.WorksheetFunction.Transpose(Application.WorksheetFunction.Transpose([Ghep])), "-") & "-"
StrGhep = Right(StrGhep, Len(LTrim(Replace(StrGhep, "-0", " "))))
KiemTra = InStr(StrGhep, Replace(Space(CotRong + 1), " ", "-0") & "-") = 0 And InStr(StrGhep, Replace(Space(CotRong), " ", "-0") & "-") > 0
End Function
Nhấp chuột vào đây để mở rộng...
- GPE có thể xem giúp hộ mình trường hợp này với ạ! Với đoạn Code trên thì chạy với Excel2003 (với file của bạn Huuthang_bd gửi lên thì chạy rất ổn), nhưng sao khi mình chép vô vào Excel2007 thì lại không chạy được ạ? Mình xin gửi cả 2 file lên: 1 file là excel2003 do bạn Huuthang_bd giúp và 1 file là excel2007 mình đã chép đoạn code trên vào nhưng không chạy được, không biết nguyên do ở đâu, vì file cuối cùng mình cần sử dụng là excel2007 (do mình cần sử dụng số cột dữ liệu trong file lớn hơn 300 cột). Mong sự giúp đỡ của các bạn! Xin cảm ơn!
 

File đính kèm

pt_hcl đã viết:
- GPE có thể xem giúp hộ mình trường hợp này với ạ! Với đoạn Code trên thì chạy với Excel2003 (với file của bạn Huuthang_bd gửi lên thì chạy rất ổn), nhưng sao khi mình chép vô vào Excel2007 thì lại không chạy được ạ? Mình xin gửi cả 2 file lên: 1 file là excel2003 do bạn Huuthang_bd giúp và 1 file là excel2007 mình đã chép đoạn code trên vào nhưng không chạy được, không biết nguyên do ở đâu, vì file cuối cùng mình cần sử dụng là excel2007 (do mình cần sử dụng số cột dữ liệu trong file lớn hơn 300 cột). Mong sự giúp đỡ của các bạn! Xin cảm ơn!
Nhấp chuột vào đây để mở rộng...
Sao bạn không lấy file đó Save as lại thành file 2007 cho khỏe. Copy code làm gì cho mất công mà lại sai.
Bạn copy Code qua file mới không chạy được là do CodeName của file bạn và CodeName file tôi khác nhau (File tôi CodeName sheet Result là Sheet7, của bạn là Sheet2).
Cách khắc phục: Sửa CodeName sheet Result lại là Sheet7 hoặc lấy file của tôi Save as thành Excel 2007
 
Mình đã dựa vào code trên và sửa thêm code của bài này tăng lên trường hợp có thể ghép 100 dòng không biết như vậy có đúng không? Nhưng khi mình chép vô vào macro thì thấy báo đỏ chỗ khai báo, mình thấy báo là sai lỗi cú pháp nhưng không biết sai cú pháp ở chỗ nào mong các bạn chỉ giúp? Code như sau ạ:
Sub GPE()
Application.ScreenUpdating = False
Dim i As Long, Dong1 As Long, Dong2 As Long, Dong3 As Long, Dong4 As Long, Dong5 As Long, Dong6 As Long, Dong7 As Long, Dong8 As Long, Dong9 As Long, Dong10 As Long, Dong11 As Long, Dong12 As Long, Dong13 As Long, Dong14 As Long, Dong15 As Long, Dong16 As Long, Dong17 As Long, Dong18 As Long, Dong19 As Long, Dong20 As Long, Dong21 As Long, Dong22 As Long, Dong23 As Long, Dong24 As Long, Dong25 As Long, Dong26 As Long, Dong27 As Long, Dong28 As Long, Dong29 As Long, Dong30 As Long, Dong31 As Long, Dong32 As Long, Dong33 As Long, Dong34 As Long, Dong35 As Long, Dong36 As Long, Dong37 As Long, Dong38 As Long, Dong39 As Long, Dong40 As Long, Dong41 As Long, Dong42 As Long, Dong43 As Long, Dong44 As Long, Dong45 As Long, Dong46 As Long, Dong47 As Long, Dong48 As Long, Dong49 As Long, Dong50 As Long, Dong51 As Long, Dong52 As Long, Dong53 As Long, Dong54 As Long, Dong55 As Long, Dong56 As Long, Dong57 As Long, Dong58 As Long, Dong59 As Long, Dong60 As Long, Dong61 As Long, Dong62 As Long, Dong63 As Long, Dong64 As
Long, Dong65 As Long, Dong66 As Long, Dong67 As Long, Dong68 As Long, Dong69 As Long, Dong70 As Long, Dong71 As Long, Dong72 As Long, Dong73 As Long, Dong74 As Long, Dong75 As Long, Dong76 As Long, Dong77 As Long, Dong78 As Long, Dong79 As Long, Dong80 As Long, Dong81 As Long, Dong82 As Long, Dong83 As Long, Dong84 As Long, Dong85 As Long, Dong86 As Long, Dong87 As Long, Dong88 As Long, Dong89 As Long, Dong90 As Long, Dong91 As Long, Dong92 As Long, Dong93 As Long, Dong94 As Long, Dong95 As Long, Dong96 As Long, Dong97 As Long, Dong98 As Long, Dong99 As Long, Dong100 As Long
.....
Dim SoDong As Long, SoCot As Long
ActiveWorkbook.Names.Add Name:="Ghep", RefersTo:="=RngDong1+RngDong2" & IIf(SoDong >= 3, "+RngDong3", "") & IIf(SoDong >= 4, "+RngDong4", "") & IIf(SoDong >= 5, "+RngDong5", "") & IIf(SoDong >= 6 "+RngDong6", "") & IIf(SoDong >= 7, "+RngDong7", "") & IIf(SoDong >= 8, "+RngDong8", "") & IIf(SoDong >= 9 "+RngDong9", "") & IIf(SoDong >= 10, "+RngDong10", "") & IIf(SoDong >= 11, "+RngDong11", "") & IIf(SoDong >= 12, "+RngDong12", "") & IIf(SoDong >= 13, "+RngDong13", "") & IIf(SoDong >= 14, "+RngDong14", "") & IIf(SoDong >= 15, "+RngDong15", "") & IIf(SoDong >=16, "+RngDong16", "") & IIf(SoDong >= 17, "+RngDong17", "") & IIf(SoDong >= 18, "+RngDong18", "") & IIf(SoDong >= 19, "+RngDong19", "") & IIf(SoDong >= 20, "+RngDong20", "") & IIf(SoDong >= 21, "+RngDong21", "") & IIf(SoDong >= 22, "+RngDong22", "") & IIf(SoDong >= 23, "+RngDong23", "") & IIf(SoDong >= 24, "+RngDong24", "") & IIf(SoDong >= 25, "+RngDong25", "") & IIf(SoDong >=26, "+RngDong26", "") & IIf(SoDong >= 27, "+RngDong27", "") & IIf(SoDong >= 2
8, "+RngDong28", "") & IIf(SoDong >= 29, "+RngDong29", "") & IIf(SoDong >= 30, "+RngDong30", "") & IIf(SoDong >= 31, "+RngDong31", "") & IIf(SoDong >= 32, "+RngDong32", "") & IIf(SoDong >= 33, "+RngDong33", "") & IIf(SoDong >= 34, "+RngDong34", "") & IIf(SoDong >= 35, "+RngDong35", "") & IIf(SoDong >=36, "+RngDong36", "") & IIf(SoDong >= 37, "+RngDong37", "") & IIf(SoDong >= 38, "+RngDong38", "") & IIf(SoDong >= 39, "+RngDong39", "") & IIf(SoDong >= 40, "+RngDong40", "") & IIf(SoDong >= 41, "+RngDong41", "") & IIf(SoDong >= 42, "+RngDong42", "") & IIf(SoDong >= 43, "+RngDong43", "") & IIf(SoDong >= 44, "+RngDong44", "") & IIf(SoDong >= 45, "+RngDong45", "") & IIf(SoDong >=46, "+RngDong46", "") & IIf(SoDong >= 47, "+RngDong47", "") & IIf(SoDong >= 48, "+RngDong48", "") & IIf(SoDong >= 49, "+RngDong49", "") & IIf(SoDong >= 50, "+RngDong50", "") & IIf(SoDong >= 51, "+RngDong51", "") & IIf(SoDong >= 52, "+RngDong52", "") & IIf(SoDong >= 53, "+RngDong53", "") & IIf(SoDong >= 54, "+RngDong54", "") & IIf(SoDong >=
55, "+RngDong55", "") & IIf(SoDong >=56, "+RngDong56", "") & IIf(SoDong >= 57, "+RngDong57", "") & IIf(SoDong >= 58, "+RngDong58", "") & IIf(SoDong >= 59, "+RngDong59", "") & IIf(SoDong >= 60, "+RngDong60", "") & IIf(SoDong >= 61, "+RngDong61", "") & IIf(SoDong >= 62, "+RngDong62", "") & IIf(SoDong >= 63, "+RngDong63", "") & IIf(SoDong >= 64, "+RngDong64", "") & IIf(SoDong >= 65, "+RngDong65", "") & IIf(SoDong >=66, "+RngDong66", "") & IIf(SoDong >= 67, "+RngDong67", "") & IIf(SoDong >= 68, "+RngDong68", "") & IIf(SoDong >= 69, "+RngDong69", "") & IIf(SoDong >= 70, "+RngDong70", "") & IIf(SoDong >= 71, "+RngDong71", "") & IIf(SoDong >= 72, "+RngDong72", "") & IIf(SoDong >= 73, "+RngDong73", "") & IIf(SoDong >= 74, "+RngDong74", "") & IIf(SoDong >= 75, "+RngDong75", "") & IIf(SoDong >=76, "+RngDong76", "") & IIf(SoDong >= 77, "+RngDong77", "") & IIf(SoDong >= 78, "+RngDong78", "") & IIf(SoDong >= 79, "+RngDong79", "") & IIf(SoDong >=80, "+RngDong80", "") & IIf(SoDong >= 81, "+RngDong81", "") & IIf(SoDong >= 8
2, "+RngDong82", "") & IIf(SoDong >= 83, "+RngDong83", "") & IIf(SoDong >= 84, "+RngDong84", "") & IIf(SoDong >= 85, "+RngDong85", "") & IIf(SoDong >=86, "+RngDong86", "") & IIf(SoDong >= 87, "+RngDong87", "") & IIf(SoDong >= 88, "+RngDong88", "") & IIf(SoDong >= 89, "+RngDong89", "") & IIf(SoDong >= 90, "+RngDong90", "") & IIf(SoDong >= 91, "+RngDong91", "") & IIf(SoDong >= 92, "+RngDong92", "") & IIf(SoDong >= 93, "+RngDong93", "") & IIf(SoDong >= 94, "+RngDong94", "") & IIf(SoDong >= 95, "+RngDong95", "") & IIf(SoDong >= 96, "+RngDong96", "") & IIf(SoDong >= 97, "+RngDong97", "") & IIf(SoDong >= 98, "+RngDong98", "") & IIf(SoDong >= 99, "+RngDong99", "") & IIf(SoDong >= 100, "+RngDong100", "")
For Dong1 = StartR To EndR
.............
Nhấp chuột vào đây để mở rộng...
Mình đã tìm ra nguyên nhân rồi! Cảm ơn các bạn!
 
Lần chỉnh sửa cuối:
Bạn phải đăng nhập hoặc đăng ký để trả lời bài viết tại đây.
Web KT

Bài viết mới nhất

saobekhonglac
Tạo form vòng quay may mắn
    • Thích
2
Trả lời
34
Đọc
15K
kllua96
K
khang2303
Lỗi đảo lộn ngày tháng khi Merger sang Word
Trả lời
0
Đọc
9
khang2303
khang2303
Q
Hỏi về công thức dò giá
Trả lời
0
Đọc
11
qthinhweb
Q
phatnguyen7301
  • Question Question
Tạo âm thanh khi nhấn vào một phím
Trả lời
4
Đọc
172
kllua96
K
X
  • Question Question
Giúp sửa code để gõ chữ thường ra được cả chữ hoa khi tìm kiếm
Trả lời
7
Đọc
53
HeSanbi
HeSanbi
quangminhici
Tặng Addin Word xuất Mail Merge có chức năng cắt ra nhiều file và gửi mail.
    • Thích
    • Yêu thích
Trả lời
17
Đọc
2K
Võ Việt Tuyến
V
H
file bị lỗi value khi copy qua file mới.
Trả lời
1
Đọc
52
Hoàng Tuấn 868
H
Thanh12Loan
Xin chào các bác. Em bị lỗi khung hiển thị excell Spreadsheet.
Trả lời
2
Đọc
65
Thanh12Loan
Thanh12Loan
LuuAnh980
Tham chiếu trong công thức bị giảm.
Trả lời
4
Đọc
84
Hoàng Tuấn 868
H
GPE-Trợ Lý
[GPE] TALK SHOW HÀM QUERY - BÍ KÍP BIẾN DỮ LIỆU KHỔNG LỒ THÀNH THÔNG TIN HỮU ÍCH TRONG TÍCH TẮC
    • Thích
    • Yêu thích
Trả lời
3
Đọc
1K
VetMini
V
PhanTuHuong
CHỌN VÀ SỬ DỤNG MÁY LỌC KHÔNG KHÍ
    • Cảm ơn
Trả lời
2
Đọc
671
PhanTuHuong
PhanTuHuong
N
Cách đánh số thứ tự không liên tục (đánh số lại từ đầu khi cột bên cạnh có giá trị)
Trả lời
8
Đọc
195
Phuocam
Phuocam
hoamattroicoi
Trích xuất file *.xml sang Excel cho hóa đơn điện tử áp dụng nghị định 123/2020
    • Thích
    • Yêu thích
    • Cảm ơn
5 6 7
Trả lời
123
Đọc
31K
kunkoi9390
K
vanle33
File không thao tác gì khi mở ra vẫn hỏi lưu lại khi tắt đi.
Trả lời
9
Đọc
154
hoangtuan.net
hoangtuan.net
H
Cách tạo nhắc nhở trong excel và tự động mở file khi có nhắc nhở
Trả lời
18
Đọc
6K
ongke0711
ongke0711
G
Chuyển Data từ hàng và cột về dạng cột
Trả lời
11
Đọc
185
ptm0412
ptm0412
P
Tại sao khi đánh số thì bị mất hai số cuối
Trả lời
4
Đọc
18K
vanle33
vanle33
HeSanbi
  • Đã giải quyết
LocalizeXL v1.71 - Làm nổi bật ô đang chọn và cuộn trang tự động
    • Thích
    • Yêu thích
2 3
Trả lời
58
Đọc
9K
HeSanbi
HeSanbi
linhvu2807
Lỗi hàm công thức Querry
Trả lời
0
Đọc
61
linhvu2807
linhvu2807
C
Tìm dữ liệu khác nhau trong 2 file hoặc 2 sheet trong excel
Trả lời
2
Đọc
146
HUONGHCKT
H
Xem thêm…

Thành viên có số lượng bài viết cao nhất tháng

Thành viên có điểm tương tác cao nhất tháng

Đếm ngược thời gian

000
Ngày
00
Giờ
00
phút
00
giây
Chúc mừng năm mới.
Back
Top Bottom