Có thể chỉnh dùm tôi CT sang VBA

Liên hệ QC
thanhtam348

thanhtam348

Thành viên thường trực
Tham gia
9/3/07
Bài viết
288
Được thích
62
Nhờ các bạn cho tôi ít thời gian chỉnh dùm công thức của bảng in bằng VBA.
Rất cám ơn.
 

File đính kèm

Sắp xếp theo thời gian sắp xếp theo bầu chọn
Mình hứa sẽ giúp, nhưng đề nghị bạn thực hiẹn các việc trung gian, như sau

1./ Ở cột nào đó tuốt fía sau của trang "DL" bạn lập danh sách duy nhất của mã hàng & kề bên nó là tên SF đó
Chúng ta thống nhất gán tên cho cột mã SF này 1 cái tên hơi triều mến 1 tẹo;

Xong việc bạn đưa file mới đè lên file cũ cái nha!

Hẹn đầu giờ chiều tái ngộ! --=0
 
Upvote 0
Cám ơn bạn nha! - xin bạn cứ thực hiện theo ý tưởng của bạn, mình thống nhất để theo.
 
Upvote 0
thanhtam348 đã viết:
Nhờ các bạn cho tôi ít thời gian chỉnh dùm công thức của bảng in bằng VBA.
Rất cám ơn.
Nhấp chuột vào đây để mở rộng...
Ở sheet "Phieu" bỏ mẹc mẹc cột F, G, H, côt Đơn giá lấy một cột thôi ( sao bạn lấy 2 cột : "hổng" hiểu!!!)
Code này mình chép vô nút để dễ kiểm tra, bạn có thể cho nó vào sự kiện của sheet cũng được
Mã: 
Private Sub CommandButton1_Click()
 Application.ScreenUpdating = False
  Dim Ws As Worksheet, Vung As Range, Cll, I As Integer
    Set Ws = Sheets("DL")
    Set Vung = Ws.Range(Ws.[f3], Ws.[f5000].End(xlUp)).Offset(0, -2)
        Range("c8:o26").ClearContents
            With Vung
                .Resize(, 16).AutoFilter Field:=1, Criteria1:="="
                .Offset(1).FormulaR1C1 = "=R[-1]C"
                .AutoFilter
            End With
        Ws.[d5000].End(xlUp).Clear
                    For Each Cll In Vung
                        If Cll = [f2] Then
                            With [c26].End(xlUp)(2)
                                .Value = Cll.Offset(0, 3) & ", " & Cll.Offset(0, 5)
                                    For I = 6 To 15
                                        .Offset(0, I - 5) = Cll.Offset(0, I)
                                    Next
                            End With
                        End If
                    Next
        With Vung
            .Offset(0, 1).Resize(, 15).AutoFilter 1, "="
            .Offset(1).ClearContents
            .AutoFilter
        End With
 Application.ScreenUpdating = True
End Sub
Thân
 

File đính kèm

Upvote 0
Thật tình cám ơn bạn nha! - chờ nảy giờ, bạn có thể giúp thêm sự kiện để khi in bảng tính được thu hẹp lại đến dòng cuối của loại hàng thôi, trông sẽ gọn hơn?
Cám ơn bạn.
 
Upvote 0
Chú còn già này lẹ thiệt ta ơi! Mình cũng loay hoay với mấy cái ô trộn khỉ gió í

PHP: 
Option Explicit

Private Sub Worksheet_Change(ByVal Target As Range)
 If Not Intersect([E6], Target) Is Nothing Then
   Dim Sh As Worksheet, Rng As Range, sRng As Range
   Dim MaKH As String, MyAdd As String:         Dim Rw As Long
   
   MaKH = Range("KhHg").Find([E6].Value, , xlFormulas, xlWhole).Offset(, -1).Value
   [C8].Resize(19, 17).ClearContents
   Set Sh = Sheets("DL"):           Set Rng = Sh.Range(Sh.[D2], Sh.[d65500].End(xlUp))
   Set sRng = Rng.Find(MaKH)
1  
  If Not sRng Is Nothing Then
      Sh.[F65500].End(xlUp).Offset(1, -2).Value = "GPE.COM"
      MyAdd = sRng.Address
      Do
         If sRng.Offset(1).Value = "" Then
            Rw = Sh.Range(sRng, sRng.End(xlDown)).Rows.Count - 1
            With [c27].End(xlUp).Offset(1)
               .Resize(Rw).Value = sRng.Offset(, 3).Resize(Rw).Value
         
               .Offset(, 3).Resize(Rw, 7).Value = sRng.Offset(, 6).Resize(Rw, 7).Value
               .Offset(, 11).Resize(Rw, 3).Value = sRng.Offset(Rw, 13).Resize(, 3).Value
               
            End With
         ElseIf sRng.Offset(1).Value <> sRng.Value Then
            With [c27].End(xlUp).Offset(1)
               .Value = sRng.Offset(, 3).Value
               .Offset(, 3).Resize(, 7).Value = sRng.Offset(, 6).Resize(, 7).Value
               .Offset(, 11).Resize(, 3).Value = sRng.Offset(, 13).Resize(, 3).Value
            End With
         End If
         Set sRng = Rng.FindNext(sRng)
      Loop While Not sRng Is Nothing And sRng.Address <> MyAdd
      Sh.[F65500].End(xlUp).Offset(1, -2).Value = ""
2
   End If
 End If
End Sub
 

File đính kèm

Chỉnh sửa lần cuối bởi điều hành viên:
Upvote 0
Concogia ơi !
Mình còn mơ hồ về VBA lắm, bạn có thể giải thích thêm được không?
Private Sub CommandButton1_Click()
Application.ScreenUpdating = False
Dim Ws As Worksheet, Vung As Range, Cll, I As Integer
Set Ws = Sheets("DL")
Set Vung = Ws.Range(Ws.[f3], Ws.[f5000].End(xlUp)).Offset(0, -2)
Range("c8:o26").ClearContents
With Vung
.Resize(, 16).AutoFilter Field:=1, Criteria1:="="
.Offset(1).FormulaR1C1 = "=R[-1]C"
.AutoFilter
End With
Ws.[d5000].End(xlUp).Clear
For Each Cll In Vung
If Cll = [f2] Then
With [c26].End(xlUp)(2)
.Value = Cll.Offset(0, 3) & ", " & Cll.Offset(0, 5)
For I = 6 To 15
.Offset(0, I - 5) = Cll.Offset(0, I)
Next
End With
End If
Next
With Vung
.Offset(0, 1).Resize(, 15).AutoFilter 1, "="
.Offset(1).ClearContents
.AutoFilter
End With
Application.ScreenUpdating = True
End Sub

Chân thành cảm ơn !
 
Lần chỉnh sửa cuối:
Upvote 0
Bạn thêm 2 dòng lệnh này vô 2 dòng mình vừa quýnh số đó

Bạn có thể giúp thêm sự kiện để khi in bảng tính được thu hẹp lại đến dòng cuối của loại hàng thôi, trông sẽ gọn hơn?
Cám ơn bạn.
Nhấp chuột vào đây để mở rộng...
PHP: 
1    [c8].Resize(27).EntireRow.Hidden = False
PHP: 
2  Range([c28], [c28].End(xlUp).Offset(2)).EntireRow.Hidden = True
Chúc thành công
 
Upvote 0
thanhtam348 đã viết:
Thật tình cám ơn bạn nha! - chờ nảy giờ, bạn có thể giúp thêm sự kiện để khi in bảng tính được thu hẹp lại đến dòng cuối của loại hàng thôi, trông sẽ gọn hơn?
Cám ơn bạn.
Nhấp chuột vào đây để mở rộng...
Chép cái này vào nút thay cái cũ nhé
Mã: 
Private Sub CommandButton1_Click()
 Application.ScreenUpdating = False
 Cells.EntireRow.Hidden = False
  Dim Ws As Worksheet, Vung As Range, Cll, I As Integer, K As Integer
    Set Ws = Sheets("DL")
    Set Vung = Ws.Range(Ws.[f3], Ws.[f5000].End(xlUp)).Offset(0, -2)
        Range("c8:o26").ClearContents
            With Vung
                .Resize(, 16).AutoFilter Field:=1, Criteria1:="="
                .Offset(1).FormulaR1C1 = "=R[-1]C"
                .AutoFilter
            End With
        Ws.[d5000].End(xlUp).Clear
                    For Each Cll In Vung
                        If Cll = [f2] Then
                            With [c26].End(xlUp)(2)
                                .Value = Cll.Offset(0, 3) & ", " & Cll.Offset(0, 5)
                                    For I = 6 To 15
                                        .Offset(0, I - 5) = Cll.Offset(0, I)
                                    Next
                            End With
                        End If
                    Next
        With Vung
            .Offset(0, 1).Resize(, 15).AutoFilter 1, "="
            .Offset(1).ClearContents
            .AutoFilter
        End With
        K = Range([c8], [c8].End(xlDown)).Rows.count
        Range(K + 9 & ":26").EntireRow.Hidden = True
 Application.ScreenUpdating = True
End Sub
Thân
 
Upvote 0
van_thanh_phong đã viết:
Concogia ơi !
Mình còn mơ hồ về VBA lắm, bạn có thể giải thích thêm được không?
Private Sub CommandButton1_Click()
Application.ScreenUpdating = False
Dim Ws As Worksheet, Vung As Range, Cll, I As Integer
Set Ws = Sheets("DL")
Set Vung = Ws.Range(Ws.[f3], Ws.[f5000].End(xlUp)).Offset(0, -2)
Range("c8:o26").ClearContents
With Vung
.Resize(, 16).AutoFilter Field:=1, Criteria1:="="
.Offset(1).FormulaR1C1 = "=R[-1]C"
.AutoFilter
End With
Ws.[d5000].End(xlUp).Clear
For Each Cll In Vung
If Cll = [f2] Then
With [c26].End(xlUp)(2)
.Value = Cll.Offset(0, 3) & ", " & Cll.Offset(0, 5)
For I = 6 To 15
.Offset(0, I - 5) = Cll.Offset(0, I)
Next
End With
End If
Next
With Vung
.Offset(0, 1).Resize(, 15).AutoFilter 1, "="
.Offset(1).ClearContents
.AutoFilter
End With
Application.ScreenUpdating = True
End Sub

Chân thành cảm ơn !
Nhấp chuột vào đây để mở rộng...
Bạn "hổng" hiểu chỗ náo thì đổi màu chỗ đó, mình mới biết mà giải thích chứ
Không chơi đổi màu toàn bộ à nha
 
Upvote 0
Xin cám ơn concogia vả HYen17 , còn chút thắc mắc dùm giúp cho: Từ Sheet "DL", cột "O" (ĐVT) có những loại mà mình cố ý xóa trắng nó đi vì lý do khách hàng thay đổi ý định, nhưng không xóa hết hàng vì mình đã định giá, để lở KH có lấy lại thì số liệu vẩn còn, vậy làm cách nào tách nó ra khi đưa vào bảng in?
Cám ơn các bạn.
 
Upvote 0
thanhtam348 đã viết:
Xin cám ơn concogia vả HYen17 , còn chút thắc mắc dùm giúp cho: Từ Sheet "DL", cột "O" (ĐVT) có những loại mà mình cố ý xóa trắng nó đi vì lý do khách hàng thay đổi ý định, nhưng không xóa hết hàng vì mình đã định giá, để lở KH có lấy lại thì số liệu vẩn còn, vậy làm cách nào tách nó ra khi đưa vào bảng in?
Cám ơn các bạn.
Nhấp chuột vào đây để mở rộng...
Tìm đoạn này trong code
Ws.[d5000].End(xlUp).Clear
For Each Cll In Vung
If Cll = [f2] And Cll.Offset(0, 11) <> "" Then
With [c26].End(xlUp)(2)
Thêm chỗ chữ màu đo đỏ "dzô"
Thân
 
Upvote 0
Rất cám ơn, xin gởi lời chúc tốt đẹp về các bạn. Ước gì cùng uống ly Cafe :fishing:||\
 
Upvote 0
Xin gặp lại concogia, HYen17 và các bạn, bạn cho xin thủ tục để bỏ nó vào sự kiện của Sheet mà không dùng nút lệnh.

Cám ơn bạn.
 
Upvote 0
Tôi lại gặp rắc rối mới: Khi còn trong File các bạn đưa lên thì code chạy tốt, nhưng khi tôi copy code vào file của tôi - tôi đổi tên Sheet thì nó không lấy dược dử liệu qua bảng in, nhờ các bạn xem lại cho giải đáp dùm.
Mã: 
Private Sub CommandButton1_Click()
 Application.ScreenUpdating = False
 Cells.EntireRow.Hidden = False
  Dim Ws As Worksheet, Vung As Range, Cll, I As Integer, K As Integer
    Set Ws = Sheets("DL") [COLOR=red]< tôi đổi tên Sheet chổ nầy[/COLOR]
    Set Vung = Ws.Range(Ws.[f3], Ws.[f5000].End(xlUp)).Offset(0, -2)
        Range("c8:o26").ClearContents
            With Vung
                .Resize(, 16).AutoFilter Field:=1, Criteria1:="="
                .Offset(1).FormulaR1C1 = "=R[-1]C"
                .AutoFilter
            End With
        Ws.[d5000].End(xlUp).Clear
                    For Each Cll In Vung
                        If Cll = [f2] And Cll.Offset(0, 11) <> "" Then
                            With [c26].End(xlUp)(2)
                                .Value = Cll.Offset(0, 3) & ", " & Cll.Offset(0, 5)
                                    For I = 6 To 15
                                        .Offset(0, I - 5) = Cll.Offset(0, I)
                                    Next
                            End With
                        End If
                    Next
        With Vung
            .Offset(0, 1).Resize(, 15).AutoFilter 1, "="
            .Offset(1).ClearContents
            .AutoFilter
        End With
        K = Range([c8], [c8].End(xlDown)).Rows.Count
        Range(K + 9 & ":26").EntireRow.Hidden = True
 Application.ScreenUpdating = True
End Sub
 
Upvote 0
thanhtam348 đã viết:
Tôi lại gặp rắc rối mới: Khi còn trong File các bạn đưa lên thì code chạy tốt, nhưng khi tôi copy code vào file của tôi - tôi đổi tên Sheet thì nó không lấy dược dử liệu qua bảng in, nhờ các bạn xem lại cho giải đáp dùm.
Mã: 
Private Sub CommandButton1_Click()
Application.ScreenUpdating = False
Cells.EntireRow.Hidden = False
Dim Ws As Worksheet, Vung As Range, Cll, I As Integer, K As Integer
Set Ws = Sheets("DL") [COLOR=red]< tôi đổi tên Sheet chổ nầy[/COLOR]
Set Vung = Ws.Range(Ws.[f3], Ws.[f5000].End(xlUp)).Offset(0, -2)
Range("c8:o26").ClearContents
With Vung
.Resize(, 16).AutoFilter Field:=1, Criteria1:="="
.Offset(1).FormulaR1C1 = "=R[-1]C"
.AutoFilter
End With
Ws.[d5000].End(xlUp).Clear
For Each Cll In Vung
If Cll = [f2] And Cll.Offset(0, 11) <> "" Then
With [c26].End(xlUp)(2)
.Value = Cll.Offset(0, 3) & ", " & Cll.Offset(0, 5)
For I = 6 To 15
.Offset(0, I - 5) = Cll.Offset(0, I)
Next
End With
End If
Next
With Vung
.Offset(0, 1).Resize(, 15).AutoFilter 1, "="
.Offset(1).ClearContents
.AutoFilter
End With
K = Range([c8], [c8].End(xlDown)).Rows.Count
Range(K + 9 & ":26").EntireRow.Hidden = True
Application.ScreenUpdating = True
End Sub
Nhấp chuột vào đây để mở rộng...
Híc, cái file mà mình "zí" chị Hải Yến làm cũng là của bạn chứ của ai
Hãy kiểm tra kỹ xem cấu trúc bảng, vị trí các trường trong cái file mới của bạn có giống "y chang" cái file cũ (cũng của bạn) hông?
Chú ý các cột mẹc mẹc, cột Số lượng ..
Nếu vẫn không chạy được thì lại....đưa nó lên cho chị Hải Yến xử nó
Hy vọng bạn làm nó chạy được
Thân
 
Upvote 0
Thì #6 là thủ tục sự kiện mà!

Xin gặp lại concogia, HYen17 và các bạn, bạn cho xin thủ tục để bỏ nó vào sự kiện của Sheet mà không dùng nút lệnh. Cám ơn bạn.
Nhấp chuột vào đây để mở rộng...

Hay bạn muốn thêm những điều bạn bổ sung sau bài #8 vô macro sự kiện này?


To CònGià: Đã giúp thì ráng giúp nốt cho bạn í đi; Còn chuyền qua chuyền lại làm chi rứa hở bồ tèo?!
 
Upvote 0
Ôi thôi! tôi đã tìm ra sai sót của mình rồi, thật tình làm phiền mấy bạn nhiều quá.
Cám ơn, và chào tạm biệt mấy bạn GBE.

PS. Tôi còn một vài bảng in khác mà cách bố trí và lấy dử liệu nhiều Sheet qua, hiện tại bảng in nó vẩn dùng công thức thì có cách nào ẩn dòng trống không các bạn ?
 
Lần chỉnh sửa cuối:
Upvote 0
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

T
  • Question Question
Xin code VBA trả về tên tài khoản theo điều kiện
    • Chấp nhận
Trả lời
12
Đọc
383
VetMini
V
mucongnghenhat
lỗi đoạn văn bản bị đóng khung
Trả lời
0
Đọc
27
mucongnghenhat
mucongnghenhat
HeSanbi
  • Question Question
VBA Nâng cao: Hướng dẫn tạo biểu thức tìm kiếm với Regular Expression
    • Thích
    • Yêu thích
Trả lời
8
Đọc
585
nguyendang95
N
Uyên dương Hoya
Lỗi định dạng form chữ trong excel
Trả lời
1
Đọc
58
DeTong
D
ntnguyentam1907
Lấy bảng dữ liệu chứng khoán về excel
2
Trả lời
22
Đọc
3K
nguyendang95
N
PhanTuHuong
CHỌN VÀ SỬ DỤNG MÁY LỌC KHÔNG KHÍ
    • Cảm ơn
Trả lời
5
Đọc
756
hoangtuan.net
hoangtuan.net
huuthang_bd
Add-in DeleteVirusMacro - Xóa và ngăn chặn virus macro
    • Thích
    • Yêu thích
    • Chấp nhận
2
Trả lời
35
Đọc
13K
minhys1
M
ongke0711
  • Question Question
Tải hóa đơn điện tử (https://hoadondientu.gdt.gov.vn/) Excel Vba
    • Thích
    • Yêu thích
    • Cảm ơn
14 15 16
Trả lời
305
Đọc
21K
pkt.bacdau
pkt.bacdau
HONGVY91
Đếm số lượng 2 cột và đếm không trùng
Trả lời
2
Đọc
117
hoangtuaotrang_hp_vn
H
hanhlx88
Nhờ giúp file Excel báo lỗi: Excel cannot complete this task with available resources
Trả lời
3
Đọc
180
hanhlx88
hanhlx88
C
Trách nhiệm pháp lý của chi nhánh doanh nghiệp Việt Nam tại nước ngoài với Công ty tại Việt Nam
Trả lời
3
Đọc
107
VetMini
V
HeSanbi
  • Đã giải quyết
LocalizeXL v1.73 - Làm nổi bật ô đang chọn và cuộn trang tự động
    • Thích
    • Yêu thích
2 3 4
Trả lời
73
Đọc
10K
HeSanbi
HeSanbi
L
Folder chứa chương trình bị khóa bởi Lock folder
2
Trả lời
28
Đọc
25K
qthangvphaui
Q
P
Xin trợ giúp cách lập lịch trực tịnh tiến dần cho 1 nhóm người.
Trả lời
4
Đọc
142
phambahoang
P
N
Tính tổng với điều kiện gần đúng
Trả lời
3
Đọc
64
HUONGHCKT
H
Bùi Thúy Thúy
  • Question Question
Lấy dữ liệu thời tiết Accuweather để điền vào nhật ký thi công
2 3 4
Trả lời
63
Đọc
19K
Mutants Men
M
Anxseo
  • Đã khóa
Cách crack my excel
Trả lời
1
Đọc
175
HeSanbi
HeSanbi
phatnguyen7301
  • Question Question
Tạo âm thanh khi nhấn vào một phím
Trả lời
5
Đọc
245
yaaasoo01
Y
anhtuan1066
  • Question Question
Chèn hình vào cell bằng hàm tự tạo
    • Thích
    • Ngạc nhiên
10 11 12
Trả lời
235
Đọc
106K
XaNguyen
X
vc_đi chơi
Khóa Hoặc mã hóa File excel có độ bảo mật cao
    • Cảm ơn
    • Thích
Trả lời
3
Đọc
204
Hoangkhang01213
Hoangkhang01213
Xem thêm…

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

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

Đếm ngược thời gian

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