Lớp học GPE tháng 10 - TPHCM: Conditional Formatting và Data Validation (tối 4, 6/10) | Excel cơ bản (tối 9, 11, 13/10) |
Thuần thục các hàm dò tìm (tối 10, 12/10) | Tất tần tật về PivotTable (tối 16, 18, 20/10) |
Tất tần tật về Filter và Advanced Filter (tối 23, 25/10) | Name động và biểu đồ (tối 24, 26, 28/10)

Đăng ký học Khởi đầu cùng Google Spreadsheet - 2 chủ nhật 1 và 8/10 - TPHCM

Đăng ký học Xây dựng ứng dụng Form bằng VBA - 2 chủ nhật 15 và 22/10 - TPHCM

Hỏi về cách chia cột trong excel

Thảo luận trong 'Định dạng, trình bày, in ấn bảng tính' bắt đầu bởi tuan206791, 3 Tháng mười một 2010.

  1. tuan206791

    tuan206791 Thành viên chính thức

    Mình có một danh sách bài hát ( file đính kèm) giờ muốn chia theo như hình đã tô màu bên cạnh thì làm theo cách nào để nhanh chóng nhất, ai biết thì chỉ giùm
     
  2. SA_DQ

    SA_DQ Thành viên danh dự

    Bạn có đòi kẻ khung không đó?

    Mã:
    Option Explicit
    Sub SaoChép()
     Dim Rng As Range, sRng As Range, cRng As Range
     Dim MyAdd As String:               Dim Rws As Long, VTr As Byte
     Const NotNhac As String = "NHAC HOT THANG "
     
     Columns("B:E").Delete
     Set Rng = Range([A1], [A65500].End(xlUp))
     Set sRng = Rng.Find(NotNhac, , xlFormulas, xlPart)
     If Not sRng Is Nothing Then
       MyAdd = sRng.Address
       Do
          [D65500].End(xlUp).Offset(2, -2).Value = sRng.Value
          Set cRng = sRng.Offset(3)
          Rws = cRng.CurrentRegion.Rows.Count
    [COLOR="blue"]'      Set cRng = cRng.Resize(Rws \ 2)'[/COLOR]
          With [B65500].End(xlUp)
             cRng.Resize(Rws \ 2).Copy Destination:=.Offset(2)
             cRng.Offset(Rws \ 2).Resize(Rws \ 2 + 1).Copy Destination:=.Offset(2, 2)
          End With
          Set sRng = Rng.FindNext(sRng)
       Loop While Not sRng Is Nothing And sRng.Address <> MyAdd
     End If
     Application.DisplayAlerts = False
     For Each Rng In Range([B3], [B65500].End(xlUp).Offset(2))
       If InStr(Rng.Value, NotNhac) Then
          Rng.HorizontalAlignment = xlCenter
          Rng.Resize(, 4).Merge
       Else
          VTr = InStr(Rng.Value, " ")
          If VTr Then
             Rng.Offset(, 1).Value = Mid(Rng.Value, VTr + 1, 99)
             Rng.Value = Left(Rng.Value, VTr - 1)
          End If
          With Rng.Offset(, 2)
             VTr = InStr(.Value, " ")
             If VTr Then
                .Offset(, 1).Value = Mid(.Value, VTr + 1, 99)
                .Value = Left(.Value, VTr - 1)
             End If
          End With
       End If
     Next Rng
     Application.DisplayAlerts = True
    End Sub
    
     

    Các file đính kèm:

    • GPEf.rar
      Kích thước:
      22.1 KB
      Đọc:
      69
    Lần chỉnh sửa cuối: 4 Tháng mười một 2010
  3. tuan206791

    tuan206791 Thành viên chính thức

    bạn chỉ giùm mình cách kẻ khung luôn và có thể thực hiện với tất cả các mục khác chứ không riên gì mục "nhạc hot" vì trong list nhạc của mình có những danh sách ca sỹ khác nữa mà mình muốn chia theo như vậy luôn. Rất cám ơn bạn vì đã giúp đỡ mình

    Mình xem bài bạn gửi cho mình , mình rất thích bạn giỏi thật. Mình muốn gửi file lên diễn đàn hỏi bạn một chút nữa mà không thấy mục tải file lên, Nếu có thể bạn cho mình xin mail và giúp đỡ mình thêm một chút nữa thì tốt. Cám ơn bạn nhiều

    Mình có file list nhạc muốn kẻ ô trình bày theo mẫu gửi kèm bên duới 1 cách nhanh nhất nhưng không biết cách, hôm trước đã có người làm giúp mình nhưng chưa đuợc hòan thành, mình nhờ ai biết thì giúp mình với. Mình cám ơn nhiều
     
    Chỉnh sửa lần cuối bởi điều hành viên: 5 Tháng mười một 2010
  4. SA_DQ

    SA_DQ Thành viên danh dự

    Mời bạn xem file


    Lần này thì quá cả iêu cầu đó nha!


    Mất cả buổi mới xong cái định dạng!
     

    Các file đính kèm:

    • GPEf.rar
      Kích thước:
      30.5 KB
      Đọc:
      68
  5. tuan206791

    tuan206791 Thành viên chính thức

    Cám ơn bạn nhiều, mình xem bạn làm quả thật là tuyệt vời. Nhưng không hiểu sao khi mình chạy với một đọan list khác thì không được và thấy báo lỗi số 9. Bạn giúp mình với nhé
     
  6. ChanhTQ@

    ChanhTQ@ Thành viên già cỗi.

    Mỗi 1 trang tính trong file của bạn có những đặc thù khác nhau & ngưởi viết macro dựa vô nó để xử lý khối dữ liệu;

    Như file đầu của bạn có các tiêu đề hoàn toàn na ná nhau & các từ đầu câu luôn giống nhau
    Còn trang tính trong file sau thì dự vô các lằn gạch đôi của bạn dước tác giả ca khúc,. . .

    Như vậy 1 macro xử lý cho 2 trường hợp cùng chung 1 trang tính là chưa có;

    Nếu muốn xử lý cả các ca khúc trong tháng & các tác giả, thì bạn cần đưa trang tính đó lên mới được.
     
  7. tuan206791

    tuan206791 Thành viên chính thức

    File list nhạc của mình thì tất cả duới tên ca sỹ đều có làn gạch đôi hết.Mình cũng đã thử chạy trên chính file gốc nhưng vẫn báo lỗi như vậy. Phiền bạn thêm lần nữa giúp mình với nhé. Cám ơn bạn nhiều lắm
     
    Lần chỉnh sửa cuối: 5 Tháng mười một 2010
  8. sondaubac

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

    Đoạn Code ở trên là sử dụng Víual basic phải không bạn?
     
  9. SA_DQ

    SA_DQ Thành viên danh dự

    Bạn đưa file gốc lên đi, canh sao cho nhiều dữ liệu nhất đó!

    To SonDauBac: đó là VBA bạn à, (VB for Application)
     
    Lần chỉnh sửa cuối: 11 Tháng mười một 2010
  10. tuan206791

    tuan206791 Thành viên chính thức

    Đây là file gốc bạn giúp mình với nhé
     
  11. HYen17

    HYen17 Thành viên cằn cỗi.

    Macro đó chỉ cần thêm 1 dòng lệnh là OK:

    Mã:
    Option Explicit
     Dim Rng As Range, sRng As Range, cRg As Range
     Dim MyAdd As String:                     Dim Rws As Long, VTr As Long
    
    [B]Sub SaoChepDanhMuc()[/B]
     Const NotNhac As String = "==":          Dim Sh As Worksheet
     Const KT As String = " ":               [B] On Error Resume Next[/B]
     Dim Cls As Range, Rg0 As Range, Color_ As Byte
    
     Set Sh = Sheets("KQua"):                 Columns("B:E").Delete
     Sheets("S2").Select:                     Sh.Columns("A:E").Delete
     Set Rng = Range([A1], [A65500].End(xlUp))
     Set sRng = Rng.Find(NotNhac, , xlFormulas, xlPart)
     If Not sRng Is Nothing Then
       MyAdd = sRng.Address
       Do
          With Sh.[c65500].End(xlUp).Offset(IIf(VTr < 1, 2, 3), -2)
             .Value = sRng.Offset(-1).Value
             .Offset(1).Value = KT & NotNhac
          End With
          Set cRg = sRng.Offset(2):          VTr = VTr + 1
          Rws = cRg.CurrentRegion.Rows.Count
          With Sh.[A65500].End(xlUp)
             cRg.Resize(Rws \ 2).Copy Destination:=.Offset(2)
             cRg.Offset(Rws \ 2).Resize(Rws \ 2 + 1).Copy Destination:=.Offset(2, 2)
          End With
          Set sRng = Rng.FindNext(sRng)
       Loop While Not sRng Is Nothing And sRng.Address <> MyAdd
     End If
     Application.DisplayAlerts = False:       Sh.Select
     Set Rng = Range([A1], [A65500].End(xlUp))
     Set sRng = Rng.Find(NotNhac)
     If Not sRng Is Nothing Then
       MyAdd = sRng.Address
       Randomize:                             Color_ = 34 + Int(6 * Rnd())
       Do
          With sRng.Offset(-1)
             .HorizontalAlignment = xlCenter:
             .Resize(, 4).Merge
             For VTr = 7 To 10
                With .Resize(, 4).Borders(VTr)
                  .LineStyle = xlContinuous:  .Weight = xlMedium
                End With
             Next VTr
          End With
          sRng.Font.ColorIndex = 2
          Set cRg = sRng.Offset(2).Resize(sRng.Offset(2, 2).CurrentRegion.Rows.Count, 4)
          cRg.Resize(, 4).Interior.ColorIndex = Color_
          Color_ = Color_ + 1:                Rws = cRg.Rows.Count
          Set Rg0 = Union(cRg.Cells(1, 1).Resize(Rws), cRg.Cells(1, 3).Resize(Rws))
          Rg0.NumberFormat = "00000":         If Color_ > 41 Then Color_ = 34
          For Each Cls In Rg0
             VTr = InStr(1, Cls.Value, KT)
             If VTr Then
                Cls.Offset(, 1).Value = Mid(Cls.Value, VTr + 1, 99)
                Cls.Value = Left(Cls.Value, VTr - 1)
             End If
          Next Cls
          Set sRng = Rng.FindNext(sRng)
       Loop While Not sRng Is Nothing And sRng.Address <> MyAdd
     End If
    Application.DisplayAlerts = True
    [B]End Sub[/B]
    
    Để tiện sử dụng, bạn cần đổi tên trang tính chứa DL (dữ liệu) của bạn thành 'S2' & lấy 1 trang tính không DL đổi thành 'KQua'; Chỉ sau đó mới chạy macro trên;

    Sở dĩ fải thêm dòng lệnh đó vì một số tiêu đề viết sẵn nhưng chưa có bài hát nào ở fần nội dụng bên dưới nó.

    (Những mong không cần đưa file lên: Tốn tài nguyên quá, bạn thông cảm!)
     
  12. tuan206791

    tuan206791 Thành viên chính thức

    Cám ơn bạn mình đã làm đuợc rồi
     

Chia sẻ trang này