Mảng danh sach tên sheet (1 người xem)

Liên hệ QC

Người dùng đang xem chủ đề này

Đang trực tuyến: 1 (Thành viên: 0, Khách: 1)
Excel365

Excel365

Thành viên tích cực
Tham gia
29/10/10
Bài viết
865
Được thích
127
Giới tính
Nam
Em muốn đưa danh sách các SHeet vo 1 mảng. Em viết như bên dưới nhưng bị sai
Dsach = Sheets(Array("Cty_Luong", "NF_Luong", "SP_Luong"))
Nhờ các anh chị giúp em điều chỉnh lại
Trân trọng
 
Sắp xếp theo thời gian sắp xếp theo bầu chọn
huuduy.duy đã viết:
Em muốn đưa danh sách các SHeet vo 1 mảng. Em viết như bên dưới nhưng bị sai
Dsach = Sheets(Array("Cty_Luong", "NF_Luong", "SP_Luong"))
Nhờ các anh chị giúp em điều chỉnh lại
Trân trọng
Nhấp chuột vào đây để mở rộng...
Bạn đưa cả file và mục đích làm gì lên xem sao?
Có phải bạn định copy danh sách các sheet?
Nếu đúng thì dùng phương thức copy thôi
Mã: 
Sheets(Array("Cty_Luong", "NF_Luong", "SP_Luong")).Copy
 
Upvote 0
huuduy.duy đã viết:
Em muốn đưa danh sách các SHeet vo 1 mảng. Em viết như bên dưới nhưng bị sai
Dsach = Sheets(Array("Cty_Luong", "NF_Luong", "SP_Luong"))
Nhờ các anh chị giúp em điều chỉnh lại
Trân trọng
Nhấp chuột vào đây để mở rộng...
Sheets(Array("....")) nó là 1 Object mà bạn, sao lại gán kiểu đó được. Phải vầy:
Mã: 
Dim [COLOR=#ff0000]Dsach As Sheets[/COLOR]
[COLOR=#ff0000]Set[/COLOR] Dsach = Sheets(Array("Cty_Luong", "NF_Luong", "SP_Luong"))
 
Upvote 0
ndu96081631 đã viết:
Sheets(Array("....")) nó là 1 Object mà bạn, sao lại gán kiểu đó được. Phải vầy:
Mã: 
Dim [COLOR=#ff0000]Dsach As Sheets[/COLOR]
[COLOR=#ff0000]Set[/COLOR] Dsach = Sheets(Array("Cty_Luong", "NF_Luong", "SP_Luong"))
Nhấp chuột vào đây để mở rộng...
Em đã chỉnh như của anh mà không được
Hiện tai thì đoạn code này em đang sử dụng
Dsach = Sheets("DS-ATM").Range("H1:H" & Sheets("DS-ATM").Range("H1").End(xlDown).Row).Value
Nay em muốn đổi lại đưa danh sách tên Các sheet vô code luôn. Nhưng không được
 
Upvote 0
huuduy.duy đã viết:
Em đã chỉnh như của anh mà không được
Hiện tai thì đoạn code này em đang sử dụng
Dsach = Sheets("DS-ATM").Range("H1:H" & Sheets("DS-ATM").Range("H1").End(xlDown).Row).Value
Nay em muốn đổi lại đưa danh sách tên Các sheet vô code luôn. Nhưng không được
Nhấp chuột vào đây để mở rộng...
Bạn nói xem mục đích của bạn là gì! Bạn đã làm gì và giờ muốn thay đổi như thế nào?
 
Upvote 0
huuduy.duy đã viết:
Mục đích của mình là copy có chọn lọc từ 3 sheet đó (Cty_Luong", "NF_Luong", "SP_Luong )về sheet DS-ATM
Nhấp chuột vào đây để mở rộng...
Dùng vòng lặp:
For each ws in worksheets
Dsach = ws.Range("H1:H" & Sheets("DS-ATM").Range("H1").End(xlDown).Row).Value
next
......
Đại loại như vậy. Vì không có File nên cũng chỉ đại khái vậy thôi!
 
Upvote 0
chuot0106 đã viết:
Bạn nói xem mục đích của bạn là gì! Bạn đã làm gì và giờ muốn thay đổi như thế nào?
Nhấp chuột vào đây để mở rộng...
Mục đích của mình là copy có chọn lọc từ 3 sheet đó (Cty_Luong", "NF_Luong", "SP_Luong )về sheet DS-ATM
Mã: 
Option Explicit
Public Sub TH_ATM()
    Dim sArr(), tArr(), Dsach(), I As Long, J As Long, K As Long, N As Long, CoL As Long, R As Long
    Dim Cll As Range, dArr(1 To 10000, 1 To 7), STT As Long
    Dim Sou As Range
    Application.ScreenUpdating = False
    [COLOR=#b22222]Dsach = Sheets("DS-ATM").Range("H1:H" & Sheets("DS-ATM").Range("H1").End(xlDown).Row).Value[/COLOR]
    On Error Resume Next
    For N = 1 To UBound(Dsach, 1)
        With Worksheets(Dsach(N, 1))
            CoL = .[XFD3].End(xlToLeft).Column
            R = .[C12].End(xlDown).Row - 2
            sArr = .[A3].Resize(R, CoL).Value
            For I = 6 To R      '4
                K = K + 1
                For J = 1 To CoL
                    If sArr(1, J) <> Empty Then
                        dArr(K, sArr(1, J)) = sArr(I, J)
                    End If
                Next J
            Next I
        End With
    Next N
    With Sheets("DS-ATM")
        .[A7:XFD1000].ClearContents
        .[A7:XFD1000].Font.Bold = False
        .[A7:XFD1000].Borders.LineStyle = 0
        .[A7:XFD1000].Font.Color = 0
        .[A7:XFD1000].Font.Size = 12
        .[A7].Resize(K, 7) = dArr
        .[A7].Resize(K, 7).Borders.LineStyle = 1
        .[A7].Resize(K, 7).Borders.LineStyle = xlContinuous
        .[A7].Resize(K, 7).Borders(xlInsideVertical).Weight = 2
        .[A7].Resize(K, 7).Borders(xlInsideHorizontal).Weight = xlHairline
        .[A7].Resize(K, 7).RowHeight = 18
        .[D7].Resize(K, 1).Font.Size = 7
        .[F7].Resize(K, 1).NumberFormat = "_(* #,##0_);_(* (#,##0);_(* ""-""_);_(@_)"
        .[D7].Resize(K).Font.Bold = False
        .[D7].Offset(, -2).Resize(K, 7).HorizontalAlignment = xlCenter
        For Each Cll In .Range(.[C7], .[C7].End(xlDown))
            If Cll.Offset(, -2) = Empty Then
                Cll.Resize(, 5).Font.Bold = True
                Cll.Resize(, 5).Font.Color = -3407872
                Cll.Resize(, 6).VerticalAlignment = xlBottom
                Cll.Resize(, 6).HorizontalAlignment = xlCenter
                Cll.Resize(, 3).ShrinkToFit = True
            Else
                STT = STT + 1: Cll.Offset(, -1) = STT
                Cll.Resize(, 1).HorizontalAlignment = xlLeft
            End If
        Next Cll
        For Each Cll In Sheets("DS-ATM").[A7:A10000].SpecialCells(2)
            Set Sou = Sheets("Data").[A4:A10000].Find(Cll.Text, , , xlWhole)
            If Not Sou Is Nothing Then Cll.Offset(, 4) = Sou.Offset(, 24)
        Next
    End With
Application.ScreenUpdating = True
End Sub
 
Upvote 0
huuduy.duy đã viết:
Mục đích của mình là copy có chọn lọc từ 3 sheet đó (Cty_Luong", "NF_Luong", "SP_Luong )về sheet DS-ATM
Mã: 
Option Explicit
Public Sub TH_ATM()
    Dim sArr(), tArr(), Dsach(), I As Long, J As Long, K As Long, N As Long, CoL As Long, R As Long
    Dim Cll As Range, dArr(1 To 10000, 1 To 7), STT As Long
    Dim Sou As Range
    Application.ScreenUpdating = False
    [COLOR=#b22222]Dsach = Sheets("DS-ATM").Range("H1:H" & Sheets("DS-ATM").Range("H1").End(xlDown).Row).Value[/COLOR]
    On Error Resume Next
    For N = 1 To UBound(Dsach, 1)
        With Worksheets(Dsach(N, 1))
            CoL = .[XFD3].End(xlToLeft).Column
            R = .[C12].End(xlDown).Row - 2
            sArr = .[A3].Resize(R, CoL).Value
            For I = 6 To R      '4
                K = K + 1
                For J = 1 To CoL
                    If sArr(1, J) <> Empty Then
                        dArr(K, sArr(1, J)) = sArr(I, J)
                    End If
                Next J
            Next I
        End With
    Next N
    With Sheets("DS-ATM")
        .[A7:XFD1000].ClearContents
        .[A7:XFD1000].Font.Bold = False
        .[A7:XFD1000].Borders.LineStyle = 0
        .[A7:XFD1000].Font.Color = 0
        .[A7:XFD1000].Font.Size = 12
        .[A7].Resize(K, 7) = dArr
        .[A7].Resize(K, 7).Borders.LineStyle = 1
        .[A7].Resize(K, 7).Borders.LineStyle = xlContinuous
        .[A7].Resize(K, 7).Borders(xlInsideVertical).Weight = 2
        .[A7].Resize(K, 7).Borders(xlInsideHorizontal).Weight = xlHairline
        .[A7].Resize(K, 7).RowHeight = 18
        .[D7].Resize(K, 1).Font.Size = 7
        .[F7].Resize(K, 1).NumberFormat = "_(* #,##0_);_(* (#,##0);_(* ""-""_);_(@_)"
        .[D7].Resize(K).Font.Bold = False
        .[D7].Offset(, -2).Resize(K, 7).HorizontalAlignment = xlCenter
        For Each Cll In .Range(.[C7], .[C7].End(xlDown))
            If Cll.Offset(, -2) = Empty Then
                Cll.Resize(, 5).Font.Bold = True
                Cll.Resize(, 5).Font.Color = -3407872
                Cll.Resize(, 6).VerticalAlignment = xlBottom
                Cll.Resize(, 6).HorizontalAlignment = xlCenter
                Cll.Resize(, 3).ShrinkToFit = True
            Else
                STT = STT + 1: Cll.Offset(, -1) = STT
                Cll.Resize(, 1).HorizontalAlignment = xlLeft
            End If
        Next Cll
        For Each Cll In Sheets("DS-ATM").[A7:A10000].SpecialCells(2)
            Set Sou = Sheets("Data").[A4:A10000].Find(Cll.Text, , , xlWhole)
            If Not Sou Is Nothing Then Cll.Offset(, 4) = Sou.Offset(, 24)
        Next
    End With
Application.ScreenUpdating = True
End Sub
Nhấp chuột vào đây để mở rộng...
Theo tôi bạn không nên dẫn người khác đi theo hướng của mình. Tốt nhất bạn nên mở 1 topic khác và nêu yêu cầu của bạn ở đó. Hướng giải quyết thế nào để người giúp tự lo.
 
Upvote 0
Cứ dần dần đi bạn. Vì người đọc code ko thấy file cứ như đi vào rừng rậm ý.
cứ cho cái file và kq mong muốn tôi nghĩ sẽ có nhiều code hay để tham khảo.
 
Upvote 0
Hay là thử thế này

Dim mysheets()
mysheets= Array("Cty_Luong", "NF_Luong", "SP_Luong")

.............
Tuy nhiên nhìn code là biết khả năng bạn chưa thể ứng dụng được vì căn bản chẳng có tẹo gì cả thì sao viết được hoàn chỉnh.
 
Upvote 0
Lần chỉnh sửa cuối:
Upvote 0
PHP: 
Option Explicit
Public Sub TH_ATM()
    Dim sArr(), tArr(), Dsach(), I As Long, J As Long, K As Long, N As Long, CoL As Long, R As Long
    Dim Cll As Range, dArr(1 To 10000, 1 To 7), STT As Long
    Dim Sou As Range
    Application.ScreenUpdating = False
    Dsach = Sheets("DS-ATM").Range("H1:H" & Sheets("DS-ATM").Range("H1").End(xlDown).Row).Value

Thứ nhất: Các loại biến cùng kiểu nên để cùng hàng
như

Dim sArr(), tArr(), Dsach(), Cll As Range, Sou As Range

Thứ hai:
Câu lệnh
Dsach = Sheets("DS-ATM").Range("H1:H" & Sheets("DS-ATM").Range("H1").End(xlDown).Row).Value
mình nghĩ là không sai (Nếu nó báo lỗi thì có thể là do lỗi chính tả ở đâu đó trong câu lệnh)

Chỉ có điều, để tránh dài dòng ta nên khai báo 1 biến đối tượng như

Dim Sh As Worksheet

Set Sh = Sheets("DS-ATM")
 
Upvote 0
huuduy.duy đã viết:
Mình gởi File lên, nhờ các a chị giúp đỡ
http://www.mediafire.com/view/ka23ewhbz7fpx5g/ATM.xlsb
Nhấp chuột vào đây để mở rộng...

Format Font, Cở chữ, màu mè,... thì Format thủ công 1 lần cho cả cột rồi thôi, đưa vào code làm gì cho rối mắt.
Nhập các số vào dòng 5 của sheet DS-ATM như trong hình, rồi chạy thử code này xem sao.
Bate1.jpg
PHP: 
Public Sub TH_ATM()
Application.ScreenUpdating = False
Dim sArr(), dArr(1 To 1000, 1 To 7), tArr(), Dsach()
Dim I As Long, J As Long, K As Long, N As Long
With Sheets("DS-ATM")
    Dsach = .Range(.[H1], .[H1].End(xlDown)).Value
    tArr = .Range("A5:F5").Value
    For N = 1 To UBound(Dsach, 1)
        With Sheets(Dsach(N, 1))
            sArr = .Range(.[A9], .[A9].End(xlDown)).Resize(, 20).Value
            For I = 1 To UBound(sArr, 1)
                K = K + 1
                dArr(K, 2) = K
                For J = 1 To UBound(tArr, 2)
                    If tArr(1, J) <> Empty Then dArr(K, J) = sArr(I, tArr(1, J))
                Next J
            Next I
        End With
    Next N
    .[A7:G1000].ClearContents
    .[A7:G1000].Borders.LineStyle = 0
        .[A7].Resize(K, 7).Value = dArr
        .[A7].Resize(K, 7).Borders.LineStyle = 1
End With
End Sub
 
Lần chỉnh sửa cuối:
Upvote 0
Cái sai đầu tiên nằm ở trong câu hỏi "bị sai".

Sai có nhiều loại sai, sai cái gì? Điển hình có mấy loại:
1. Code bị lỗi, báo ngay từ đầu? cho biết nó bôi đỏ dòng nào.
2. Code chạy bị khựng? cho biết nó báo lỗi gì, bôi vàng dòng nào.
3. Code chạy êm ái nhưng ra kết quả không như ý muốn? cho biết dữ liệu ra sao, kết quả ra sao và kết quả mong muốn ra sao.

Nếu bạn chịu khó làm rõ rệt ngay từ đầu thì có lẽ giờ này mọi việc đã giải quyết xong.
 
Upvote 0
Bạn phải đăng nhập hoặc đăng ký để trả lời bài viết tại đây.

Bài viết mới nhất

B
Sau 1 tháng Mã Lại reset về 1 trở lên
Trả lời
6
Đọc
74
ongke0711
ongke0711
ongke0711
  • Question Question
Tải hóa đơn điện tử (https://hoadondientu.gdt.gov.vn/) Excel Vba (1 người xem)
    • Thích
    • Yêu thích
    • Cảm ơn
3 4 5
Trả lời
411
Đọc
50K
ongke0711
ongke0711
H
Đánh số thứ thự phiếu thu chi (1 người xem)
Trả lời
11
Đọc
155
HangktGTN
H
H
Tìm kiếm thông tin chi tiết trên sheet tổng hợp
Trả lời
1
Đọc
48
LOGANWover
L
N
  • Question Question
Cho em hỏi về mail merge bằng vba
Trả lời
3
Đọc
74
Hoàng Tuấn 868
H
T
Xin hỏi về bảng lương
Trả lời
0
Đọc
44
tuandovn
T
Gà Công Nghệ
Tô màu họ và tên bị trùng từ 2 sheet khác nhau (2 người xem)
Trả lời
6
Đọc
100
Gà Công Nghệ
Gà Công Nghệ
A
  • Question Question
Giải thích giúp mình code giải phóng bộ nhớ từ biến (1 người xem)
Trả lời
20
Đọc
9K
nguyendang95
N
Nguyenkhang2404
giúp đỡ lọc dữ liệu nâng cao
Trả lời
22
Đọc
716
Phan Thế Hiệp
Phan Thế Hiệp
B
Dùng button trên forrm để gọi bàn phím ảo win 10(OSK) (3 người xem)
Trả lời
5
Đọc
117
huhumalu
H
P
VẼ ĐƯỜNG TẦN SUẤT (DTS) TRÊN EXCEL (1 người xem)
Trả lời
8
Đọc
184
ptm0412
ptm0412
P
GOAL SEEK NÂNG CAO TRONG EXCEL (2 người xem)
    • Thích
Trả lời
4
Đọc
195
Hoale85
H
B
Gán Phím Tắt Gọi Form
Trả lời
7
Đọc
94
HeSanbi
HeSanbi
K
Điền giá trị ô thay vì địa chỉ ô
Trả lời
2
Đọc
124
LOGANWover
L
G
Chia sẻ các bạn File vẽ kèo Zamil từ excel
    • Thích
    • Yêu thích
Trả lời
11
Đọc
907
trqt82
T
T
Xin trợ giúp cách lọc trùng về khoảng thời gian (1 người xem)
Trả lời
10
Đọc
2K
Phan Thế Hiệp
Phan Thế Hiệp
L
Xin hàm trích xuất chuỗi trong ô (3 người xem)
Trả lời
12
Đọc
195
LINH7979
L
H
[Xin giúp đỡ] Tìm thời gian trùng ở nhiều khoảng thời gian khác nhau. (1 người xem)
Trả lời
14
Đọc
2K
Phan Thế Hiệp
Phan Thế Hiệp
N
Thuế thu nhập cá nhân
    • Chấp nhận
Trả lời
3
Đọc
272
ngouyen1505
N
D
Lọc các ô có dữ liệu trùng nhau trong một cột. Xin chỉ giúp
Trả lời
7
Đọc
308
Gà Công Nghệ
Gà Công Nghệ
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

Thời gian đếm ngược.

000
Ngày
00
Giờ
00
phút
00
giây
Thân mời tham dự sự kiện sinh nhật GPE 2025
Back
Top Bottom