Tạo Menu sheet có vùng dữ liệu

Liên hệ QC

vanvan9697

Thành viên chính thức
Tham gia
11/5/12
Bài viết
94
Được thích
5
Em có 1 File có nhiều sheet, Trong mỗi sheet đều có điêu để của dữ liệu. Em Muốn làm đoạn sub có thể lấy được tất cả các tiêu đề vào menu sheet ( Trừ sheet Menu) và có thể sửa tên tiêu đề các sheet. anh (chị ) giúp em với ạ. Em cảm ơn anh (Chị ) đã giúp đỡ em ạ !
 

File đính kèm

  • MenuSheet_vung.xlsx
    29.5 KB · Đọc: 19
Em có 1 File có nhiều sheet, Trong mỗi sheet đều có điêu để của dữ liệu. Em Muốn làm đoạn sub có thể lấy được tất cả các tiêu đề vào menu sheet ( Trừ sheet Menu) và có thể sửa tên tiêu đề các sheet. anh (chị ) giúp em với ạ. Em cảm ơn anh (Chị ) đã giúp đỡ em ạ !

Bắt ghế ngồi xem học hỏi
 
Em có 1 File có nhiều sheet, Trong mỗi sheet đều có điêu để của dữ liệu. Em Muốn làm đoạn sub có thể lấy được tất cả các tiêu đề vào menu sheet ( Trừ sheet Menu) và có thể sửa tên tiêu đề các sheet. anh (chị ) giúp em với ạ. Em cảm ơn anh (Chị ) đã giúp đỡ em ạ !
Lấy tên tiêu đề thì còn hiểu
PHP:
Public Sub LayTieuDe()
Dim Ws As Worksheet, Arr(), dArr(1 To 10000, 1 To 2)
Dim J As Long, K As Long, N As Long, WsName As String
For Each Ws In ThisWorkbook.Worksheets
    If Ws.Name <> "Menu" Then
        WsName = Ws.Name
        N = Ws.Range("XFD1").End(xlToLeft).Column
        If N = 1 Then N = N + 1
        Arr = Ws.Range("A1").Resize(, N).Value
        For J = 1 To N
            If Arr(1, J) <> Empty Then
                K = K + 1
                dArr(K, 1) = WsName
                dArr(K, 2) = Arr(1, J)
            End If
        Next J
    End If
Next Ws
Sheets("Menu").Range("A2:B10000").ClearContents
Sheets("Menu").Range("A2:B2").Resize(K) = dArr
End Sub

Sửa là sao chưa biết.
 
Lấy tên tiêu đề thì còn hiểu
PHP:
Public Sub LayTieuDe()
Dim Ws As Worksheet, Arr(), dArr(1 To 10000, 1 To 2)
Dim J As Long, K As Long, N As Long, WsName As String
For Each Ws In ThisWorkbook.Worksheets
    If Ws.Name <> "Menu" Then
        WsName = Ws.Name
        N = Ws.Range("XFD1").End(xlToLeft).Column
        If N = 1 Then N = N + 1
        Arr = Ws.Range("A1").Resize(, N).Value
        For J = 1 To N
            If Arr(1, J) <> Empty Then
                K = K + 1
                dArr(K, 1) = WsName
                dArr(K, 2) = Arr(1, J)
            End If
        Next J
    End If
Next Ws
Sheets("Menu").Range("A2:B10000").ClearContents
Sheets("Menu").Range("A2:B2").Resize(K) = dArr
End Sub

Sửa là sao chưa biết.
chắc là sửa theo số thứ tự của sheets bác à làm phát cho nó loạn luôn :D
 
Lấy tên tiêu đề thì còn hiểu
PHP:
Public Sub LayTieuDe()
Dim Ws As Worksheet, Arr(), dArr(1 To 10000, 1 To 2)
Dim J As Long, K As Long, N As Long, WsName As String
For Each Ws In ThisWorkbook.Worksheets
    If Ws.Name <> "Menu" Then
        WsName = Ws.Name
        N = Ws.Range("XFD1").End(xlToLeft).Column
        If N = 1 Then N = N + 1
        Arr = Ws.Range("A1").Resize(, N).Value
        For J = 1 To N
            If Arr(1, J) <> Empty Then
                K = K + 1
                dArr(K, 1) = WsName
                dArr(K, 2) = Arr(1, J)
            End If
        Next J
    End If
Next Ws
Sheets("Menu").Range("A2:B10000").ClearContents
Sheets("Menu").Range("A2:B2").Resize(K) = dArr
End Sub

Sửa là sao chưa biết.
Dạ ví dụ tiêu đề 01 >> tên mới của sheet Du lieu 01 được thay ở tiêu đề luôn anh ạ của sheet du lieu 01
1542251059597.png
 
Dạ ví dụ tiêu đề 01 >> tên mới của sheet Du lieu 01 được thay ở tiêu đề luôn anh ạ của sheet du lieu 01
View attachment 207701
Bạn sửa lại bài #1 (chữ màu đỏ) cho rõ lại.
Em có 1 File có nhiều sheet, Trong mỗi sheet đều có điêu để của dữ liệu.
Viết thí thí như vầy xem sao:
PHP:
Public Sub SuaTieuDe()
Dim Ws As Worksheet, sArr(), TieuDe(), WsName As String
Dim I As Long, J As Long, N As Long, R As Long
sArr = Sheets("Menu").Range("A2", Sheets("Menu").Range("A2").End(xlDown)).Resize(, 3).Value
R = UBound(sArr)
For I = 1 To R
    If sArr(I, 1) <> WsName Then
        WsName = sArr(I, 1)
        J = 0
        ReDim TieuDe(1 To 1, 1 To 100)
        For N = I To R
            If sArr(N, 1) = WsName Then
                J = J + 1
                If sArr(N, 3) <> Empty Then
                    TieuDe(1, J) = sArr(N, 3)
                Else
                    TieuDe(1, J) = sArr(N, 2)
                End If
            Else
                I = N - 1
                Exit For
            End If
        Next N
        Sheets(WsName).Range("A1").Resize(, J) = TieuDe
    End If
Next I
End Sub
 
Lần chỉnh sửa cuối:
Bạn sửa lại bài #1 (chữ màu đỏ) cho rõ lại.

Viết thí thí như vầy xem sao:
PHP:
Public Sub SuaTieuDe()
Dim Ws As Worksheet, sArr(), TieuDe(), WsName As String
Dim I As Long, J As Long, N As Long, R As Long
sArr = Sheets("Menu").Range("A2", Sheets("Menu").Range("A2").End(xlDown)).Resize(, 3).Value
R = UBound(sArr)
For I = 1 To R
    If sArr(I, 1) <> WsName Then
        WsName = sArr(I, 1)
        J = 0
        ReDim TieuDe(1 To 1, 1 To 100)
        For N = I To R
            If sArr(N, 1) = WsName Then
                J = J + 1
                If sArr(N, 3) <> Empty Then
                    TieuDe(1, J) = sArr(N, 3)
                Else
                    TieuDe(1, J) = sArr(N, 2)
                End If
            Else
                I = N - 1
                Exit For
            End If
        Next N
        Sheets(WsName).Range("A1").Resize(, J) = TieuDe
    End If
Next I
End Sub
Thank anh ạ. Đúng ý em rồi ạ
 
Anh cho em hỏi thêm vấn đề này với ạ. em chạy file xong thường có thông báo out of memory, Em không biết sao lại bị vậy !. em cảm ơn anh ạ
 
Web KT
Back
Top Bottom