Đăng ký học Excel - PivotTable 3 buổi tối (31/7, 2 và 4/8) - TPHCM

Chuyên đề giải đáp những thắc mắc về code VBA

Thảo luận trong 'Lập Trình với Excel' bắt đầu bởi maytinhvp01, 31 Tháng bảy 2013.

  1. mhieuit

    mhieuit Thành viên hoạt động

    Mã:
    lastRow = .Range("B65000").End(xlUp).Row
    Mình đổi như bên trên, nhưng cột B của mình có công thức, nên dòng cuối sẽ lấy ô công thức cuối cùng, trong khi dữ liệu mình cần in nằm ở phía trên
     
  2. befaint

    befaint |||||||||||||

    Vậy sẽ có các cách:
    - Dùng mảng duyệt các phần tử ở cột B (từ dưới lên), nếu có giá trị thì lấy từ dòng đó.
    - Dùng ô phụ nào đó trong bảng tính để xác định dòng cuối cần in, dùng countif(), match(),max()...
    Theo cách 2 cho đơn giản:
    Công thức tại [Z1]:
    Mã:
    Z1=MAX($B$6:$B$9000)+5
    Sub:
    PHP:
    Sub gioihanvungin()
    Dim lastRow As Long
    With Sheets
    (1)
        
    lastRow = .Range("Z1").Value
        
    .PageSetup.PrintArea "B1:F" lastRow
    End With
    End Sub
     
    Lần chỉnh sửa cuối: 12 Tháng bảy 2017
    mhieuit thích bài này.
  3. mhieuit

    mhieuit Thành viên hoạt động

    mình hiểu rồi, code như bên dưới:
    Chúc bạn ngủ ngon. cám ơn bạn rất nhiều
    Mã:
    Sub gioihanvungin()
    Dim lastRow As Long
    With Sheets(1)
        lastRow = .Range("A5") 'Dùng cột phụ hàm countif()
        .PageSetup.PrintArea = "B1:F" & lastRow
    End With
    End Sub
     
    befaint thích bài này.
  4. phuyen89

    phuyen89 Thành viên tích cực

    Thuộc tính PrinArea trả về String nên bạn viết vậy không đúng cú pháp đâu.
    Mã:
    Property PrintArea As String
     
  5. mhieuit

    mhieuit Thành viên hoạt động

    Chào befaint,
    Từ cdoe bên dưới mình muốn sort cột D va F theo chiều tăng dần thì sẽ code như thế nào, bạn giúp mình nhé. Cám ơn bạn nhiều.
    Sub:
    PHP:
    Sub gioihanvungin()
    Dim lastRow As Long
    With Sheets
    (1)
        
    lastRow = .Range("Z1").Value
        
    .PageSetup.PrintArea "B1:F" lastRow
    End With
    End Sub
     
  6. befaint

    befaint |||||||||||||

    Ủa, sort thì liên quan gì tới tạo vùng in? :eek::eek:
    Bạn record macro xem...
     
    mhieuit thích bài này.
  7. mhieuit

    mhieuit Thành viên hoạt động

    ý mình là sau khi giới hạn vùng in xong mình sort dữ liệu rồi mới in
     
  8. phuyen89

    phuyen89 Thành viên tích cực

    Nếu bạn thích, bạn có thể dùng tinh năng Sort của Excel, để ghi lại Macro.
     
    mhieuit thích bài này.
  9. mhieuit

    mhieuit Thành viên hoạt động

    Mình dùng record macro nhưng khi bỏ ................vào thì phát sinh lỗi nên mình không sử sụng
    PHP:
    For 2 To 20
            
    If Sheets("Pickticket").Range("A" i).Value <> Empty Then
                Sheets
    ("Pickticket").Range("B" i).copy
                Sheets
    ("DN").Range("E6").PasteSpecial Paste:=xlPasteValues
                Application
    .CutCopyMode False
                Dim lastRow 
    As Long
        With Sheets
    ("DN")
            
    lastRow = .Range("A10").Value
            
    .PageSetup.PrintArea "C1:S" lastRow
    .............................
        
    End With
        With Sheets
    ("DN").PageSetup
            
    .PrintTitleRows "$10:$10"
        
    End With
            Sheets
    ("DN").copy after:=Sheets("DN")
            
    End If
        
    Next i
     
  10. befaint

    befaint |||||||||||||

    Cứ ghi macro cái thao tác sort đi đã. Làm gì mà đã ghép mấy bài vô rồi.
    Không dùng cái dòng nhiều chấm (......) đó, xóa nó đi vì nó đâu là code trong VBA (thêm dấu nháy đơn vào đầu dòng).

    '-----
    Tình hình hơi căng, chắc phải học lý thuyết trước thôi hoặc tìm người kèm.
     
    HieuCD, mhieuitPacificPR thích bài viết này.
  11. mhieuit

    mhieuit Thành viên hoạt động

    Xóa nội dung vì không phù hợp topic
     
    Lần chỉnh sửa cuối: 14 Tháng bảy 2017
  12. befaint

    befaint |||||||||||||

    Giờ có 2 phương án:
    1- Nếu tiếp tục ở box này (Giải đáp thắc mắc...) thì chỉ gửi cái khúc sort lên trước (kèm thêm file cho mọi người dễ xem hơn thì càng tốt).
    2- Lập một topic mới, nêu toàn bộ yêu cầu.
     
    mhieuit thích bài này.
  13. mhieuit

    mhieuit Thành viên hoạt động

    mình xin lỗi, mình quên đây là topic giải đáp thắc mắc.
    Các Mod xóa giúp mình những bài không liên quan topic này nhé. cám ơn nhiều
     
  14. befaint

    befaint |||||||||||||

    Không có lỗi lầm gì. Không cần xóa gì. Ây dza.
     
    mhieuit thích bài này.
  15. minhvdn

    minhvdn Thành viên mới

    Các cao nhân cho em hỏi, giờ em có 1 vấn đề ntn
    - em có 1 bảng (K9:X35), và đang cần điền dữ liệu bằng cách tham chiếu giá trị từ 1 dãy khác. Bảng K9:X35 sẽ được điền lần lượt từ trên xuống dưới (9 đến 35), rồi từ cột trái sang cột phải (K đến X), và giá trị sẽ nằm từ cột AN đến cột PA của dãy kia. Em đang định dùng 3 vòng lặp for cho i(dòng), j(cột) và k(cột tham chiếu), đang có code như sau
    "
    Dim i As Integer, j As Integer, k As Integer
    For k = 40 To 417
    For j = 11 To 24
    For i = 9 To 35
    Sheets("Laisuat").Cells(i, j).Value = Application.WorksheetFunction.VLookup(Ngay, Dulieu, k, False)
    Next i
    Next j
    Next k"
    *bảng K9:X35 ở sheet Laisuat, dãy tham chiếu là Dulieu.
    Nếu thế này thì khi chạy macro tất cả các ô cần điền giá trị sẽ trả về giá trị ở cột cuối cùng của bảng tham chiếu (cột PA), giống nhau hết.
    Có anh chị nào giúp em tìm ra code đúng với, xin cảm ơn nhiều ạ.
     
  16. phuyen89

    phuyen89 Thành viên tích cực

    Bạn không đưa File, mình đọc thật khó hình dung.
     
    PacificPR thích bài này.
  17. minhvdn

    minhvdn Thành viên mới

    Nó giống vậy ạ, em chỉ dummy data thôi
     

    Các file đính kèm:

    • Copy.xlsm
      Kích thước:
      18.6 KB
      Đọc:
      1
  18. Nguyen Dong Hai

    Nguyen Dong Hai Thành viên mới

    Xin nhờ mọi người giúp giùm,

    Mình có 1 sub như trên diễn đàn hướng dẫn:

    Function PicFit(ByVal PictureFileName As String, Optional ByVal TargetCell As Range) As String
    On Error Resume Next
    If TargetCell Is Nothing Then Set TargetCell = Application.ThisCell
    TargetCell.Worksheet.Shapes(TargetCell.Address).Delete
    If CreateObject("Scripting.FileSystemObject").fileExists(PictureFileName) Then
    TargetCell.Select
    With TargetCell.Worksheet.Pictures.Insert(PictureFileName)
    .Name = TargetCell.Address
    .ShapeRange.LockAspectRatio = msoFalse
    .Left = TargetCell.Left
    .Top = TargetCell.Top
    .Width = TargetCell.Width
    .Height = TargetCell.Height
    End With
    End If
    End Function

    Sử dụng để add picture vào 1 worksheet rất ổn, nhưng khi send file cho máy khác thì lại không có link nên ko thấy hình. Có cách nào để add vĩnh viễn, sau khi mở ra nó không tự tìm link nữa hay không?

    Cảm ơn mọi người giúp đỡ.
     
  19. nguyentranduc1978

    nguyentranduc1978 Thành viên mới

    Em có đoạn code gộp nhiều file sang 1 file mới chạy trên office 2007 không được. Folder "OK" chạy ổn nhưng folder "Khong duoc" chạy bị lỗi

    Em muốn chèn nguồn của dữ liệu truy xuất, file Vidu (STT, dòng và sheet của các file 1,2,3 và 4,5,6 vào cột A trước các hàng gộp dữ liệu có được không). Ví dụ cột A dòng 2 thể hiện: C:\Documents and Settings\Admin\Desktop\OK\4.xls\Ngày1\row2


    Sub MergeFilesExcel()
    Dim path As String, ThisWB As String, lngFilecounter As Long
    Dim wbDest As Workbook, shtDest As Worksheet, ws As Worksheet
    Dim Filename As String, Wkb As Workbook
    Dim CopyRng As Range, Dest As Range
    Dim RowofCopySheet As Integer
    RowofCopySheet = 2
    ThisWB = ActiveWorkbook.Name
    'Dien duong dan folder chua cac tap tin excel can gom lai.
    'Nhu ban thay toi tien duong dan thu muc chua cai file excel cua toi.
    path = "D:\Test\Khong duoc"
    Application.EnableEvents = False
    Application.ScreenUpdating = False
    Set shtDest = ActiveWorkbook.Sheets(1)
    Filename = Dir(path & "\*.xls", vbNormal)
    If Len(Filename) = 0 Then Exit Sub
    Do Until Filename = vbNullString
    If Not Filename = ThisWB Then
    Set Wkb = Workbooks.Open(Filename:=path & "\" & Filename)
    Set CopyRng = Wkb.Sheets(1).Range(Cells(RowofCopySheet, 1), Cells(ActiveSheet.UsedRange.Rows.Count, ActiveSheet.UsedRange.Columns.Count))
    Set Dest = shtDest.Range("A" & shtDest.UsedRange.SpecialCells(xlCellTypeLastCell).Row + 1)
    CopyRng.Copy Dest
    Wkb.Close False
    End If
    Filename = Dir()
    Loop
    Range("A1").Select
    Application.EnableEvents = True
    Application.ScreenUpdating = True
    MsgBox "Ket Thuc!"
    End Sub
     

    Các file đính kèm:

  20. mhieuit

    mhieuit Thành viên hoạt động

    Chào anh chị GPE,
    em muốn xóa từ sheets(8) trở về sau, nhưng đoạn code bên dưới khi chạy không xóa như yêu cầu,
    anh chị xem giúp em code này chưa đúng ở đoạn nhé. em cám ơn

    PHP:
    Sub xoasheets()
    Dim j As Integer
    Application
    .DisplayAlerts False
        
    For 8 To Sheets.Count
            Sheets
    (j).Delete
        Next j
    Application
    .DisplayAlerts True
    End Sub
     

Chia sẻ trang này