Ghép dòng với nhiều điều kiện (1 người xem)

  • Thread starter Thread starter pt_hcl
  • Ngày gửi Ngày gửi
Liên hệ QC

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

Đang trực tuyến: 1 (Thành viên: 0, Khách: 1)
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

nguyenhoangtuananh9897
Hỏi về nơi tải danh sách xã huyện tỉnh chuẩn (3 người xem)
2 3
Trả lời
43
Đọc
3K
ongke0711
ongke0711
OrangeBee
Xin nhờ anh chị giúp đỡ về CommandButton Userform. (3 người xem)
Trả lời
2
Đọc
39
OrangeBee
OrangeBee
ptm0412
Hình ảnh sinh nhật GPE lần 19 tại HCM (4 người xem)
    • Yêu thích
Trả lời
0
Đọc
22
ptm0412
ptm0412
Nga1852k
lỗi excel không chèn được dòng và không xóa được dòng (1 người xem)
Trả lời
0
Đọc
38
Nga1852k
Nga1852k
K
  • Question Question
Viết code cho file lấy dữ liệu in -out từ bảng chấm công
Trả lời
1
Đọc
96
yaaasoo01
Y
GPE-Trợ Lý
[ĐÀ NẴNG] ĐĂNG KÝ THAM DỰ SINH NHẬT GIAIPHAPEXCEL LẦN THỨ 19 NGÀY 13/07/2025 (3 người xem)
    • Thích
Trả lời
6
Đọc
357
nguyenhuong
nguyenhuong
vc_đi chơi
Cộng ngày từ sheet này sang sheet khác bị nhảy lung tung (1 người xem)
Trả lời
8
Đọc
136
vc_đi chơi
vc_đi chơi
ongke0711
  • Question Question
Tải hóa đơn điện tử (https://hoadondientu.gdt.gov.vn/) Excel Vba (1 người xem)
    • Thích
    • Yêu thích
    • Cảm ơn
17 18 19
Trả lời
369
Đọc
42K
zzklzz
Z
N
Tạo COM Add-In bằng Visual C++
Trả lời
0
Đọc
97
nguyendang95
N
N
Giãn dòng trong excel (1 người xem)
Trả lời
0
Đọc
76
nguyenichky
N
Phan Thế Hiệp
Tìm ngày giờ kết thúc dự kiến
    • Thích
    • Yêu thích
Trả lời
17
Đọc
711
Phan Thế Hiệp
Phan Thế Hiệp
GPE-Trợ Lý
[HCM] ĐĂNG KÝ THAM DỰ SINH NHẬT GIAIPHAPEXCEL LẦN THỨ 19 NGÀY 06/07/2025
    • Thích
    • Yêu thích
Trả lời
14
Đọc
1K
PhanTuHuong
PhanTuHuong
N
  • Question Question
Hỗ trợ tiếng việt trong macro (1 người xem)
Trả lời
10
Đọc
343
ptm0412
ptm0412
T
Hướng dẫn kết hợp Drop List và Group PivotTable có điều kiện
Trả lời
7
Đọc
220
ptm0412
ptm0412
Limhachung
Lỗi không copy past excel
Trả lời
3
Đọc
94
vanle33
vanle33
V
Xử lý dữ liệu bị âm
Trả lời
9
Đọc
294
HieuCD
H
Nguyễn Duy Tuân
  • Dán lên cao
Phiên bản mới Add-in A-Tools AI v10 (2024) (1 người xem)
    • Thích
2 3
Trả lời
57
Đọc
7K
Nguyễn Duy Tuân
Nguyễn Duy Tuân
N
gộp sheet có chứa hình ảnh
Trả lời
1
Đọc
105
thuytrangbp28
T
OverAC
  • Dán lên cao
  • Suggestion Suggestion
Chúc mừng sinh nhật GiaiPhapExcel 19 tuổi và tặng ebook "Lập trình VBA phần cơ bản."
    • Thích
    • Yêu thích
Trả lời
3
Đọc
896
PhanTuHuong
PhanTuHuong
nguyenthidao2906
cách gộp nhiều file về 1 file trong google sheet
Trả lời
5
Đọc
1K
nguyen thao1712
N
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

Sinh nhật lần 19 GPE

000
Ngày
00
Giờ
00
phút
00
giây
Thân mời tham dự sự kiện sinh nhật GPE 2025
Back
Top Bottom