Chèn dòng vào giữa 2 dòng theo điều kiện

Thiên Thanh1 · 25/10/20

Anh chị và các bạn ơi, giúp em với
Em cảm ơn trước nhé!

PacificPR · 25/10/20

Thiên Thanh1 đã viết:
Anh chị và các bạn ơi, giúp em với
Em cảm ơn trước nhé!

Quy luật chèn cái "B trả lời" như thế nào vậy Bạn

Thiên Thanh1 · 25/10/20

PacificPR đã viết:
Quy luật chèn cái "B trả lời" như thế nào vậy Bạn

Cảm ơn bạn
Tức là dòng nàođược chèn vào thìđiền câuđó vào bạn ơi.

PacificPR · 25/10/20

Thiên Thanh1 đã viết:
Cảm ơn bạn
Tức là dòng nàođược chèn vào thìđiền câuđó vào bạn ơi.

Bạn chạy thử xem nhé

PHP:

Sub Insert_Row()
    Dim sRng As Range, Rng As Range
    Dim sArr(), dArr(1 To 65535, 1 To 1)
    Dim I As Long, K As Long, B As String
B = "B: Tr" & ChrW$(7843) & " l" & ChrW$(7901) & "i"
On Error GoTo Thoat
Set sRng = Application.InputBox(Prompt:="GPE ", Title:="Chon du lieu dau vao", Type:=8)
If sRng.Rows.Count * sRng.Columns.Count > 1 Then
    sArr = sRng.Value
    For I = 1 To UBound(sArr)
    
            If Len(sArr(I, 1)) <= 10 Then
                K = K + 1: dArr(K, 1) = sArr(I, 1)
                If Len(sArr(I + 1, 1)) > 10 Then
                    K = K + 1: dArr(K, 1) = sArr(I + 1, 1): I = I + 1
                End If
            Else
                K = K + 1: dArr(K, 1) = B
                K = K + 1:   dArr(K, 1) = sArr(I, 1)
            End If
     
    Next I
    If K Then
        Set Rng = Application.InputBox(Prompt:="GPE ", Title:="Chon o ghi du lieu", Type:=8)
        Rng.Resize(K, 1) = dArr
    End If
End If
Thoat:
End Sub

Thiên Thanh1 · 25/10/20

PacificPR đã viết:

Bạn chạy thử xem nhé

PHP:

Sub Insert_Row()
    Dim sRng As Range, Rng As Range
    Dim sArr(), dArr(1 To 65535, 1 To 1)
    Dim I As Long, K As Long, B As String
B = "B: Tr" & ChrW$(7843) & " l" & ChrW$(7901) & "i"
On Error GoTo Thoat
Set sRng = Application.InputBox(Prompt:="GPE ", Title:="Chon du lieu dau vao", Type:=8)
If sRng.Rows.Count * sRng.Columns.Count > 1 Then
    sArr = sRng.Value
    For I = 1 To UBound(sArr)
   
            If Len(sArr(I, 1)) <= 10 Then
                K = K + 1: dArr(K, 1) = sArr(I, 1)
                If Len(sArr(I + 1, 1)) > 10 Then
                    K = K + 1: dArr(K, 1) = sArr(I + 1, 1): I = I + 1
                End If
            Else
                K = K + 1: dArr(K, 1) = B
                K = K + 1:   dArr(K, 1) = sArr(I, 1)
            End If
    
    Next I
    If K Then
        Set Rng = Application.InputBox(Prompt:="GPE ", Title:="Chon o ghi du lieu", Type:=8)
        Rng.Resize(K, 1) = dArr
    End If
End If
Thoat:
End Sub

Chuẩn quá bạn ơi
Cảm ơn bạn rất nhiều
Chúc bạn cuối tuần vui vẻ.

Thiên Thanh1 · 26/10/20

Bạn @PacificPR ơi chỉnh sử giúp mình với nhé
Mình chỉnh code của bạn như này nhưng nó không chạy
Chúc bạn ngày đầu tuần có nhiều thành công nhé.


[CODE]Sub Insert_Row()
    Dim sRng As Range, Rng As Range
    Dim sArr(), dArr(1 To 65535, 1 To 1)
    Dim I As Long, K As Long, B As String
B = "B: Tr" & ChrW$(7843) & " l" & ChrW$(7901) & "i"
On Error GoTo Thoat
        'Set sRng = Application.InputBox(Prompt:="GPE ", Title:="Chon du lieu dau vao", Type:=8)
    Set sRng = Range("B1:B2500")
If sRng.Rows.Count * sRng.Columns.Count > 1 Then
    sArr = sRng.Value
    For I = 1 To UBound(sArr)
    
            If Len(sArr(I, 1)) <= 10 Then
                K = K + 1: dArr(K, 1) = sArr(I, 1)
                If Len(sArr(I + 1, 1)) > 10 Then
                    K = K + 1: dArr(K, 1) = sArr(I + 1, 1): I = I + 1
                End If
            Else
                K = K + 1: dArr(K, 1) = B
                K = K + 1:   dArr(K, 1) = sArr(I, 1)
            End If
    
    Next I
    If K Then
        'Set Rng = Application.InputBox(Prompt:="GPE ", Title:="Chon o ghi du lieu", Type:=8)
        Range("B65").Resize(K, 1) = dArr
    End If
End If
Thoat:
End Sub
[/CODE]

PacificPR · 26/10/20

Thiên Thanh1 đã viết:
Bạn @PacificPR ơi chỉnh sử giúp mình với nhé
Mình chỉnh code của bạn như này nhưng nó không chạy
Chúc bạn ngày đầu tuần có nhiều thành công nhé.[CODE]Sub Insert_Row() Dim sRng As Range, Rng As Range Dim sArr(), dArr(1 To 65535, 1 To 1) Dim I As Long, K As Long, B As String B = "B: Tr" & ChrW$(7843) & " l" & ChrW$(7901) & "i" On Error GoTo Thoat 'Set sRng = Application.InputBox(Prompt:="GPE ", Title:="Chon du lieu dau vao", Type:=8) Set sRng = Range("B1:B2500") If sRng.Rows.Count * sRng.Columns.Count > 1 Then sArr = sRng.Value For I = 1 To UBound(sArr) If Len(sArr(I, 1)) <= 10 Then K = K + 1: dArr(K, 1) = sArr(I, 1) If Len(sArr(I + 1, 1)) > 10 Then K = K + 1: dArr(K, 1) = sArr(I + 1, 1): I = I + 1 End If Else K = K + 1: dArr(K, 1) = B K = K + 1: dArr(K, 1) = sArr(I, 1) End If Next I If K Then 'Set Rng = Application.InputBox(Prompt:="GPE ", Title:="Chon o ghi du lieu", Type:=8) Range("B65").Resize(K, 1) = dArr End If End If Thoat: End Sub [/CODE]

Bạn xem thử nhé

PHP:

Sub Insert_Row()
    Dim sArr(), dArr(1 To 65535, 1 To 1)
    Dim I As Long, K As Long, B As String
B = "B: Tr" & ChrW$(7843) & " l" & ChrW$(7901) & "i"
sArr = Range("B1", Range("B1").End(xlDown)).Value
For I = 1 To UBound(sArr)
    If Len(sArr(I, 1)) <= 10 Then
        K = K + 1: dArr(K, 1) = sArr(I, 1)
        If Len(sArr(I + 1, 1)) > 10 Then
            K = K + 1: dArr(K, 1) = sArr(I + 1, 1): I = I + 1
        End If
    Else
        K = K + 1: dArr(K, 1) = B
        K = K + 1:   dArr(K, 1) = sArr(I, 1)
    End If
Next I
If K Then
    Range("B65", Range("B65").End(xlDown)).ClearContents
    Range("B65").Resize(K, 1) = dArr
End If
End Sub

Thiên Thanh1 · 26/10/20

PacificPR đã viết:

Bạn xem thử nhé

PHP:

Sub Insert_Row()
    Dim sArr(), dArr(1 To 65535, 1 To 1)
    Dim I As Long, K As Long, B As String
B = "B: Tr" & ChrW$(7843) & " l" & ChrW$(7901) & "i"
sArr = Range("B1", Range("B1").End(xlDown)).Value
For I = 1 To UBound(sArr)
    If Len(sArr(I, 1)) <= 10 Then
        K = K + 1: dArr(K, 1) = sArr(I, 1)
        If Len(sArr(I + 1, 1)) > 10 Then
            K = K + 1: dArr(K, 1) = sArr(I + 1, 1): I = I + 1
        End If
    Else
        K = K + 1: dArr(K, 1) = B
        K = K + 1:   dArr(K, 1) = sArr(I, 1)
    End If
Next I
If K Then
    Range("B65", Range("B65").End(xlDown)).ClearContents
    Range("B65").Resize(K, 1) = dArr
End If
End Sub

Cảm ơn bạn @PacificPR chuẩn rồi bạn ơi
Cảm ơn bạn rất nhiều nhé.
Chúc bạn vạn sự thành công

Thiên Thanh1 · 26/10/20

Bạn @PacificPR kiểm tra lại giúp mình với
Mình thấy nó vẫn sai sai bạn ơi

PacificPR · 26/10/20

Thiên Thanh1 đã viết:
Bạn @PacificPR kiểm tra lại giúp mình với
Mình thấy nó vẫn sai sai bạn ơi

Sao trong file của bạn cái If Len(sArr(I + 1, 1)) > 10 Then nó lại thành If Len(sArr(I + 1, 1)) > 20 Then rồi

Thiên Thanh1 · 26/10/20

PacificPR đã viết:
Sao trong file của bạn cái If Len(sArr(I + 1, 1)) > 10 Then nó lại thành If Len(sArr(I + 1, 1)) > 20 Then rồi

Bởi vì mình cho nó điều kiện có nhiều hơn 20 ký tự mà
Nếu cho điều kiện khác thì code bị sai bạn à
Bạn nghiên cứu giúp mình "Khi sửa cho các điều kiện khác thì code vẫn đúng với nhé"
Cảm ơn bạn!

PacificPR · 26/10/20

Thiên Thanh1 đã viết:
Bởi vì mình cho nó điều kiện có nhiều hơn 20 ký tự mà
Nếu cho điều kiện khác thì code bị sai bạn à
Bạn nghiên cứu giúp mình "Khi sửa cho các điều kiện khác thì code vẫn đúng với nhé"
Cảm ơn bạn!

Mình đang chốt với nhau là ở chỗ 10 ký tự mà

hungtin1997 · 26/10/20

Thiên Thanh1 đã viết:
Anh chị và các bạn ơi, giúp em với
Em cảm ơn trước nhé!

Thử xem nào bác.
Cột D không có ô trống nhé.

Mã:

Sub Macro3()
Dim i As String
i = InputBox("Search", "Thông báo")
     Columns("D:D").Select
    Selection.Replace What:=i, Replacement:="", LookAt:=xlPart, _
        SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
        ReplaceFormat:=False
    Selection.SpecialCells(xlCellTypeBlanks).Select
    Selection.FormulaR1C1 = i
    Selection.EntireRow.Insert , CopyOrigin:=xlFormatFromLeftOrAbove
    Columns("D:D").Select
    Selection.SpecialCells(xlCellTypeBlanks).Select
    Selection.FormulaR1C1 = "OK______"
End Sub

PacificPR · 26/10/20

hungtin1997 đã viết:

Thử xem nào bác.
Cột D không có ô trống nhé.

Mã:

Sub Macro3()
Dim i As String
i = InputBox("Search", "Thông báo")
     Columns("D:D").Select
    Selection.Replace What:=i, Replacement:="", LookAt:=xlPart, _
        SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
        ReplaceFormat:=False
    Selection.SpecialCells(xlCellTypeBlanks).Select
    Selection.FormulaR1C1 = i
    Selection.EntireRow.Insert , CopyOrigin:=xlFormatFromLeftOrAbove
    Columns("D:D").Select
    Selection.SpecialCells(xlCellTypeBlanks).Select
    Selection.FormulaR1C1 = "OK______"
End Sub

Hai Bạn này vào diễn đàn cùng ngày ( 16 Tháng mười 2020 ) nè

hungtin1997 · 26/10/20

PacificPR đã viết:
Hai Bạn này vào diễn đàn cùng ngày ( 16 Tháng mười 2020 ) nè

Sớm hơn cơ, tại quên mất mật khẩu tạo tài khoản mới, nhưng cùng ngày thì sao bác?

PacificPR · 26/10/20

hungtin1997 đã viết:
Sớm hơn cơ, tại quên mất mật khẩu tạo tài khoản mới, nhưng cùng ngày thì sao bác?

Hì hì. Thì chỉ là vào diễn đàn cùng một ngày thôi

Thiên Thanh1 · 26/10/20

hungtin1997 đã viết:

Thử xem nào bác.
Cột D không có ô trống nhé.

Mã:

Sub Macro3()
Dim i As String
i = InputBox("Search", "Thông báo")
     Columns("D:D").Select
    Selection.Replace What:=i, Replacement:="", LookAt:=xlPart, _
        SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
        ReplaceFormat:=False
    Selection.SpecialCells(xlCellTypeBlanks).Select
    Selection.FormulaR1C1 = i
    Selection.EntireRow.Insert , CopyOrigin:=xlFormatFromLeftOrAbove
    Columns("D:D").Select
    Selection.SpecialCells(xlCellTypeBlanks).Select
    Selection.FormulaR1C1 = "OK______"
End Sub

Bạn ơi, bạn đưa code vào file và chọn vùng chính xác giúp mình với nhé.

hongphuong1997 · 26/10/20

PacificPR đã viết:
Hì hì. Thì chỉ là vào diễn đàn cùng một ngày thôi

Hi hi anh @PacificPR oi, hình như cái thằng kia lại là cái loại phá đám và phá diễn đàn GPE đó anh oi.

Bài đã được tự động gộp: 26/10/20

@PacificPR anh cười giề?
Em phát hiện chuẩn đó.
Anh nhìn code của nó đê.

Thiên Thanh1 · 26/10/20

Mình biết gì đâu mà @hongphuong1997 nói thế?
Bạn @PacificPR giúp mình với nhé.

hungtin1997 · 27/10/20

hongphuong1997 đã viết:
Hi hi anh @PacificPR oi, hình như cái thằng kia lại là cái loại phá đám và phá diễn đàn GPE đó anh oi.

Bài đã được tự động gộp: 26/10/20

@PacificPR anh cười giề?
Em phát hiện chuẩn đó.
Anh nhìn code của nó đê.

@PacificPR đang nói "2 thằng" bạn cho mình hỏi là bạn đang nói "thằng" nào?

Chèn dòng vào giữa 2 dòng theo điều kiện

Thành viên mới

File đính kèm

Thành viên mới

Thành viên mới

Thành viên mới

Thành viên mới

Thành viên mới

File đính kèm

Thành viên mới

Thành viên mới

Thành viên mới

File đính kèm

Thành viên mới

File đính kèm

Thành viên mới

Thành viên mới

Dậm chân tại chỗ là đi lùi

Thành viên mới

Dậm chân tại chỗ là đi lùi

Thành viên mới

Thành viên mới

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

Thành viên mới

Dậm chân tại chỗ là đi lùi