Hỗ trợ VBA Chèn nhiều cột trong excel

[toanphansy]

Thưa các a/c
Em đang cố gắng làm 1 đoạn code phục vụ cho việc chèn thêm nhiều cột vào 1 vị trí chọn sẵn trong worksheet nhưng có gặp 1 lỗi này nhờ các cao nhân chỉ giáo giúp em ạ. Em xin phép được copy ảnh ở dưới ạ.
Em xin cảm ơn.
Em xin gửi đoạn code dưới nhé:

Sub insertMutilCols()
    'Tat ung dung excel trong luc chay Macro
    Application.Calculation = xlCalculationManual
    Application.EnableEvents = False
    Application.ScreenUpdating = False
        
        'Khai bao bien so luong cot muon chen them
        Dim iCountCols As Long
        Dim ColRef, ColRef2 As String
    
        
            'Thiet lap gia tri cho ColRef và ColRef2
            ColRef = Replace(ActiveCell(, Column + 1).address, "$1", "")
            ColRef2 = Right(ColRef, Len(ColRef) = 1)
            
            'Kich hoat thong bao - Trong dieu kien có bao nhieu cot de chen vao
            iCountCols = Application.InputBox(Prompt:="Ban muon chen them bao nhieu cot vào sau cot " _
                & ColRef2 & "?", Type:=1)
              
                
            'Bao loi va ket thuc Macro neu so cot là so am hoac khong phai la so tu nhien
            If iCountCols <= 0 Then End
            
            'Dua tren cot da xac dinh, chen them so cot da dien o inbox tren
            Selection.Resize(, iCountCols).EntireColumn.Insert Shift:=xlRight
            
    'Mo lai excel khi hoan tat viec chay macro
    Application.Calculation = xlCalculationAutomatic
    Application.EnableEvents = True
    Application.ScreenUpdating = True
            
End Sub

 

[hoanganhvo2612]

Thưa các a/c
Em đang cố gắng làm 1 đoạn code phục vụ cho việc chèn thêm nhiều cột vào 1 vị trí chọn sẵn trong worksheet nhưng có gặp 1 lỗi này nhờ các cao nhân chỉ giáo giúp em ạ. Em xin phép được copy ảnh ở dưới ạ.
Em xin cảm ơn.
View attachment 209647
View attachment 209648

Cái khai báo column đâu? mà bạn đưa cả file lên để mọi người dễ kiểm tra.

 

[toanphansy]

Cái khai báo column đâu? mà bạn đưa cả file lên để mọi người dễ kiểm tra.

em gửi lại đoạn code ở trên #1 rồi, a xem giúp em. Tks a

 

[HeSanbi]

em gửi lại đoạn code ở trên #1 rồi, a xem giúp em. Tks a

Sang đây lấy cái Hàm trả về Ký tự Cột
Link: Đánh thứ tự ký tự bằng Hàm hoặc Code - Sử dụng toán chỉnh hợp
Áp dụng cho code trên:

ColRef = inStrSeries(Selection.Column + 1)

-------------------------------------------------------------------------------------------
Với Code trên có thể sửa đơn giản là: ActiveCell(, ActiveCell.Column + 1)
Nhưng không ai đi dùng hàm Replace để lấy Ký Tự Cột

 

[snow25]

em gửi lại đoạn code ở trên #1 rồi, a xem giúp em. Tks a

Mục đích bạn làm 2 cái này làm gì.
ColRef = Replace(ActiveCell(, Column + 1).address, "$1", "")
ColRef2 = Right(ColRef, Len(ColRef) = 1)
Sao không dùng row luôn.

 

[cơn gió]

Cái khai báo column đâu? mà bạn đưa cả file lên để mọi người dễ kiểm tra.

Anh ơi giúp em kiểm tra file này với ạ, em xuất phiếu lương ra file pdf nhưng không mở được file ạ.

 

[toanphansy]

Mục đích bạn làm 2 cái này làm gì.
ColRef = Replace(ActiveCell(, Column + 1).address, "$1", "")
ColRef2 = Right(ColRef, Len(ColRef) = 1)
Sao không dùng row luôn.

em muốn đẩy ra chỗ InputBox là " Bạn muốn chèn thêm bao nhiêu cột vào sau cột "xyz"? "xyz" là A or B Or C .... ạ

 

[snow25]

em muốn đẩy ra chỗ InputBox là " Bạn muốn chèn thêm bao nhiêu cột vào sau cột "xyz"? "xyz" là A or B Or C .... ạ

Bạn điền cái code này vào xem nhé.

Function Coleter(Clls As Range) As String
    Coleter = Replace(Cells(1, Clls.Column + 1).Address(0, 0), 1, "")
End Function

Sub insertMutilCols()
    'Tat ung dung excel trong luc chay Macro
    Application.Calculation = xlCalculationManual
    Application.EnableEvents = False
    Application.ScreenUpdating = False
        
        'Khai bao bien so luong cot muon chen them
        Dim iCountCols As Long
        Dim colref, ColRef2 As String
    
        
            'Thiet lap gia tri cho ColRef và ColRef2
        
            ColRef2 = Coleter(Selection)
            
            'Kich hoat thong bao - Trong dieu kien có bao nhieu cot de chen vao
            iCountCols = Application.InputBox(Prompt:="Ban muon chen them bao nhieu cot vào sau cot " _
                & ColRef2 & "?", Type:=1)
              
                
            'Bao loi va ket thuc Macro neu so cot là so am hoac khong phai la so tu nhien
            If iCountCols <= 0 Then End
            
            'Dua tren cot da xac dinh, chen them so cot da dien o inbox tren
            Selection.Resize(, iCountCols).EntireColumn.Insert Shift:=xlRight
            
    'Mo lai excel khi hoan tat viec chay macro
    Application.Calculation = xlCalculationAutomatic
    Application.EnableEvents = True
    Application.ScreenUpdating = True
            
End Sub

 

[toanphansy]

Bạn điền cái code này vào xem nhé.

Function Coleter(Clls As Range) As String
    Coleter = Replace(Cells(1, Clls.Column + 1).Address(0, 0), 1, "")
End Function

Sub insertMutilCols()
    'Tat ung dung excel trong luc chay Macro
    Application.Calculation = xlCalculationManual
    Application.EnableEvents = False
    Application.ScreenUpdating = False
       
        'Khai bao bien so luong cot muon chen them
        Dim iCountCols As Long
        Dim colref, ColRef2 As String
   
       
            'Thiet lap gia tri cho ColRef và ColRef2
       
            ColRef2 = Coleter(Selection)
           
            'Kich hoat thong bao - Trong dieu kien có bao nhieu cot de chen vao
            iCountCols = Application.InputBox(Prompt:="Ban muon chen them bao nhieu cot vào sau cot " _
                & ColRef2 & "?", Type:=1)
             
               
            'Bao loi va ket thuc Macro neu so cot là so am hoac khong phai la so tu nhien
            If iCountCols <= 0 Then End
           
            'Dua tren cot da xac dinh, chen them so cot da dien o inbox tren
            Selection.Resize(, iCountCols).EntireColumn.Insert Shift:=xlRight
           
    'Mo lai excel khi hoan tat viec chay macro
    Application.Calculation = xlCalculationAutomatic
    Application.EnableEvents = True
    Application.ScreenUpdating = True
           
End Sub

Chạy tốt a nhé tks a.
Tuy nhiên đoạn này e có sửa 1 chút là:
Coleter = Replace(Cells(1, Clls.Column + 1).Address(0, 0), 1, "") >>>> Coleter = Replace(Cells(1, Clls.Column).Address(0, 0), 1, "")
Liệu mình có thể mở rộng ra thành 1 code Insert nhiều cột cho nhiều vị trí có bước nhảy = n không nhỉ? Xin được chỉ giáo thêm ạ.

 

[snow25]

Chạy tốt a nhé tks a.
Tuy nhiên đoạn này e có sửa 1 chút là:
Coleter = Replace(Cells(1, Clls.Column + 1).Address(0, 0), 1, "") >>>> Coleter = Replace(Cells(1, Clls.Column).Address(0, 0), 1, "")
Liệu mình có thể mở rộng ra thành 1 code Insert nhiều cột cho nhiều vị trí có bước nhảy = n không nhỉ? Xin được chỉ giáo thêm ạ.

Được bạn nghiên cứu gắn thêm vòng lặp là được.