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

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

  • GhepDong All.rar
    24 KB · Đọc: 10
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

  • GPE.rar
    1.2 MB · Đọc: 20
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

  • Ghep3Dong_ChanhTQ.rar
    19.2 KB · Đọc: 11
  • GhepDong All.rar
    65.7 KB · Đọc: 32
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

  • Ghepdong_Phuctap.rar
    56.9 KB · Đọc: 12
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

  • Ghepdong-Phuctap.rar
    40.6 KB · Đọc: 23
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

  • GhepDong All.rar
    29.2 KB · Đọc: 22
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

  • GPE_GHÉP 50-60-70-80-90 DONG.xlsx
    154.9 KB · Đọc: 4
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

  • GhepdongAll.rar
    41 KB · Đọc: 7
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

chip07
Tách 1 dòng trong sheet thành 1 file riêng có thể cập nhật được
Trả lời
3
Đọc
34
Hoàng Tuấn 868
H
U
VLOOKUP nhiều cột
    • Chấp nhận
Trả lời
9
Đọc
285
uronmapu
U
M
Không định dạng được dưới dạng Short Date
Trả lời
1
Đọc
25
ptm0412
ptm0412
S
Hướng dẫn gán 1 biến workbook
Trả lời
10
Đọc
107
ptm0412
ptm0412
D
Phân công và sắp xếp lịch trực
Trả lời
10
Đọc
249
HieuCD
H
befaint
Chia sẻ tâm tư, xả nỗi lòng
    • Thích
35 36 37
Trả lời
736
Đọc
43K
SA_DQ
SA_DQ
PhanTuHuong
Các địa phương thiệt hại nặng nề do bão lũ 2024
    • Thích
2
Trả lời
23
Đọc
807
SA_DQ
SA_DQ
T
  • Question
Tính tồn đầu , tồn cuối , nhập trong kỳ , xuất trong kỳ
Trả lời
11
Đọc
270
thierry henry
T
GPE-Trợ Lý
Đà Nẵng - Đăng ký tham dự sinh nhật GIAIPHAPEXECL lần thứ 18 ngày 05/10/2024
    • Thích
    • Yêu thích
Trả lời
9
Đọc
202
Maika8008
Maika8008
GPE-Trợ Lý
TP.HCM - Đăng ký tham dự sinh nhật GIAIPHAPEXCEL lần thứ 18 ngày 06/10/2024
    • Thích
2
Trả lời
21
Đọc
1K
ptm0412
ptm0412
T
Hàm Sumifs nhiều điều kiện bị lỗi value hoặc trả về 0
Trả lời
14
Đọc
232
ptm0412
ptm0412
ongke0711
  • Question
Trộn dữ liệu từ Excel sang Word mở rộng (phiên bản ongke0711)
    • Thích
    • Yêu thích
    • Cảm ơn
11 12 13
Trả lời
255
Đọc
23K
ngochienbmt
N
C
Công thức gộp 2 cột thành 1 (dữ liệu gộp so le)
Trả lời
10
Đọc
961
nguyenhuyen0805
N
H
  • Question
Lập trình số liệu Nhập-Xuất-Tồn
2
Trả lời
23
Đọc
420
HUONGHCKT
H
A
  • Question
Nhờ tìm lỗi code không delete các dòng theo điều kiện
    • Cười
2
Trả lời
29
Đọc
467
SA_DQ
SA_DQ
Kiều Mạnh
Lấy dữ liệu cổ phiếu từ Website Cafef.vn về Excel
    • Thích
3 4 5
Trả lời
81
Đọc
3K
Kiều Mạnh
Kiều Mạnh
C
Quản lý tồn kho ván gỗ
Trả lời
10
Đọc
2K
tamthanhpytn
T
H
Xin giúp đỡ công thức excel để tính nâng lương định kỳ
Trả lời
17
Đọc
9K
ngoclam081077
N
K
Lọc dữ liệu gần nhất trong cột
Trả lời
4
Đọc
127
Hoàng Tuấn 868
H
Q
  • Question
Nhờ các bác hướng dẫn hàm filter dùm.
Trả lời
7
Đọc
212
quen_tat_ca
Q
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

Back
Top Bottom