phamanh195
Thành viên mới
- Tham gia
- 13/8/19
- Bài viết
- 2
- Được thích
- 0
E muốn chia dữ liệu của một sheet thành các sheet riêng lẻ.
Dữ liệu gồm có tên thành phố và các thông số, e lọc ra thành các sheet theo tên của thành phố đó. Sau đó tìm ra giá trị max và min của từng thành phố rồi thống kê lại thành 1 bảng.
Mọi người vui lòng xem và chỉ giúp e với ạ. E cám ơn.
Private Sub Split_inf()
Const col = "D"
Const header_row = 1
Const starting_row = 2
Dim sourse_sheet As Worksheet
Dim destination_sheet As Worksheet
Dim source_row As Long
Dim last_row As Long
Dim destination_row As Long
Dim city As String
Set source_sheet = ActiveSheet
last_row = source_sheet.Cells(source_sheet.Rows.Count, col).End(xlUp).Row
For source_row = starting_row To last_row
city = source_sheet.Cells(source_row, col).Value
Set destination_sheet = Nothing
On Error Resume Next
Set destination_sheet = Worksheets(city)
On Error GoTo 0
If destination_sheet Is Nothing Then
Set destination_sheet = Worksheets.Add(after:=Worksheets(Worksheets.Count))
destination_sheet.Name = city
source_sheet.Rows(header_row).Copy Destination:=destination_sheet.Rows(header_row)
End If
destination_row = destination_sheet.Cells(destination_sheet.Rows.Count, col).End(xlUp).Row + 1
source_sheet.Rows(sourse_row).Copy Destination:=destination_sheet.Rows(destination_row)
Next source_row
End Sub
Dữ liệu gồm có tên thành phố và các thông số, e lọc ra thành các sheet theo tên của thành phố đó. Sau đó tìm ra giá trị max và min của từng thành phố rồi thống kê lại thành 1 bảng.
Mọi người vui lòng xem và chỉ giúp e với ạ. E cám ơn.
Private Sub Split_inf()
Const col = "D"
Const header_row = 1
Const starting_row = 2
Dim sourse_sheet As Worksheet
Dim destination_sheet As Worksheet
Dim source_row As Long
Dim last_row As Long
Dim destination_row As Long
Dim city As String
Set source_sheet = ActiveSheet
last_row = source_sheet.Cells(source_sheet.Rows.Count, col).End(xlUp).Row
For source_row = starting_row To last_row
city = source_sheet.Cells(source_row, col).Value
Set destination_sheet = Nothing
On Error Resume Next
Set destination_sheet = Worksheets(city)
On Error GoTo 0
If destination_sheet Is Nothing Then
Set destination_sheet = Worksheets.Add(after:=Worksheets(Worksheets.Count))
destination_sheet.Name = city
source_sheet.Rows(header_row).Copy Destination:=destination_sheet.Rows(header_row)
End If
destination_row = destination_sheet.Cells(destination_sheet.Rows.Count, col).End(xlUp).Row + 1
source_sheet.Rows(sourse_row).Copy Destination:=destination_sheet.Rows(destination_row)
Next source_row
End Sub
