Tạo một vùng dữ liệu? (1 người xem)
- Thread starter trongntk
- Ngày gửi
Người dùng đang xem chủ đề này
keentwo
Thành viên thường trực
- Tham gia
- 14/3/10
- Bài viết
- 211
- Được thích
- 185
- Nghề nghiệp
- SV DHXD
-Của bạn đây nhé.
(
vẫn đang tập viết excel nên chưa rút gọn đâu,nhẽ ra nên chọn quét cả 1 vùng nhưng thôi copy từng cột cho dễ hiểu)
(
vẫn đang tập viết excel nên chưa rút gọn đâu,nhẽ ra nên chọn quét cả 1 vùng nhưng thôi copy từng cột cho dễ hiểu)
PHP:
Sub Data()
Dim Rng As Range
Dim i As Double
i = Sheet2.Range("B5").Value
Sheet1.Select
For Each Rng In ActiveSheet.Range("B5", [b65536].End(xlUp))
If Rng.Value = i Then
Application.ScreenUpdating = False
Rng.Offset(, 1).Resize(12).Copy Sheet2.Range("C5")
Rng.Offset(, 2).Resize(12).Copy Sheet2.Range("D5")
Rng.Offset(, 3).Resize(12).Copy
Sheet2.Range("E5").PasteSpecial xlPasteValues
Rng.Offset(, 4).Resize(12).Copy
Sheet2.Range("F5").PasteSpecial xlPasteValues
Rng.Offset(, 5).Resize(12).Copy
Sheet2.Range("G5").PasteSpecial xlPasteValues
End If
Next
Application.ScreenUpdating = True
End Sub
Upvote
0
Mình cũng đang học viết nên cần phải nghiên cứu nhiều! Nhưng bạn hiểu sai ý của mình, mình muốn nói là khi nhập một mã ở sheet bảng hiển thị tương đượng với mã ở bảng dữ liệu thì nó copy toàn bộ vùng dữ liệu thuộc cái mã đó sang bên shees hiển thị! Cảm ơn bạn đã nhiệt tình giúp đỡ!
Upvote
0
- Tham gia
- 8/6/06
- Bài viết
- 14,689
- Được thích
- 23,043
- Nghề nghiệp
- U80
Xem & kiểm macro sự kiện sau
PHP:
Option Explicit
Private Sub Worksheet_Change(ByVal Target As Range)
If Not Intersect(Target, [b5]) Is Nothing Then
Dim Sh As Worksheet, Rng As Range, sRng As Range
Dim SoDòng As Long
Set Sh = Sheets("DuLieu")
Set Rng = Sh.Range(Sh.[b5], Sh.[B65500].End(xlUp))
Target.CurrentRegion.Offset(, 1).ClearContents
[B6].Resize(22).ClearContents
Set sRng = Rng.Find([b5].Value, , xlFormulas, xlWhole)
If sRng Is Nothing Then
MsgBox "Nothing"
Else
[b5].Resize(22).EntireRow.Hidden = False
SoDòng = sRng.Offset(, -1).End(xlDown).Row - sRng.Row - 1
If SoDòng > 16 Then SoDòng = 16
[B6].Resize(SoDòng).Value = sRng.Offset(1).Resize(SoDòng).Value
[c5].Resize(SoDòng, 6).Value = sRng.Offset(, 1).Resize(SoDòng, 6).Value
Range("H6").FormulaR1C1 = "=SUM(R[1]C:R[15]C)"
Range("H22").FormulaR1C1 = "=R[-16]C"
Range([c21], [c21].End(xlUp).Offset(2)).EntireRow.Hidden = True
End If
End If
End Sub
Upvote
0
ChanhTQ@
0901452không62
- Tham gia
- 5/9/08
- Bài viết
- 4,254
- Được thích
- 4,861
Theo mình hiểu, macro đã làm được chuyện đó rồi mà
Chú í macro đang làm việc đúng khi 1 mã số chứa 16 dòng dữ liệu thôi;
Nếu mã số nào đó >16 dòng công việc sẽ chép sang sai với form sẵn có. (Lúc này, nếu bạn chưa tiến triển gì trong việc tự chỉnh sửa macro theo công việc fát sinh thì lại fải nhờ tới diễn đàn thân thương của chúng ta làm vậy!)
Chúc bạn nhiều thành công & tiến bộ!
Bạn thử nhập thêm vài dòng dữ liệu cho mã số mới ở bên 'DuLieu', như mã tiếp theo sau mã 01.1094 là 01.1199 & nhập đúng mã đó i xì vô [B5] của 'Hien Thi' xem sao?
Chú í macro đang làm việc đúng khi 1 mã số chứa 16 dòng dữ liệu thôi;
Nếu mã số nào đó >16 dòng công việc sẽ chép sang sai với form sẵn có. (Lúc này, nếu bạn chưa tiến triển gì trong việc tự chỉnh sửa macro theo công việc fát sinh thì lại fải nhờ tới diễn đàn thân thương của chúng ta làm vậy!)
Chúc bạn nhiều thành công & tiến bộ!
Upvote
0
- Tham gia
- 8/6/06
- Bài viết
- 14,689
- Được thích
- 23,043
- Nghề nghiệp
- U80
Có thể chưa hoàn toàn hiểu í bạn!
Hiện tại ta nhập vô [B5] , thì khu vực từ dòng này cho đến dòng 21 có dữ liệu sẽ hiện lên;
Hay là bạn muốn vấn đề như vầy:
Bây giờ nhập thêm mã nào đó có ở 'DuLieu' vô ô [B25] thì fía dưới nó hiện dữ liệu của mã tương ứng vừa nhập?
Nếu vậy bạn hãy chọn cho mình chuỗi số biểu thị dòng nhập dùm cái, như
(*) 5 , 25, 45,. . .
(*) 5, 30, 55,. . . .
(*) (Chuỗi của bạn thích. . . .
Hiện tại ta nhập vô [B5] , thì khu vực từ dòng này cho đến dòng 21 có dữ liệu sẽ hiện lên;
Hay là bạn muốn vấn đề như vầy:
Bây giờ nhập thêm mã nào đó có ở 'DuLieu' vô ô [B25] thì fía dưới nó hiện dữ liệu của mã tương ứng vừa nhập?
Nếu vậy bạn hãy chọn cho mình chuỗi số biểu thị dòng nhập dùm cái, như
(*) 5 , 25, 45,. . .
(*) 5, 30, 55,. . . .
(*) (Chuỗi của bạn thích. . . .
Upvote
0
Bạn ơi! mình diễn giải lại cụ thể thế này này:
Mình có một bảng rất là nhiều dữ liệu (gọi là bản dữ liệu) nó đã có sẵn ở bảng đó.
Còn bên bảng biển thị thì tại cột B mình muỗn sử dụng mã nào thì mình chỉ cần nhập đúng mã đó thôi là nó hiện ra như bạn vừa làm cho mình với ô B5 đó. Ban giúp mình với nhé mình muốn hóc để làm đước như bạn nhưng học lâu quá không có thầy dạy nữa!
Upvote
0
- Tham gia
- 8/6/06
- Bài viết
- 14,689
- Được thích
- 23,043
- Nghề nghiệp
- U80
Bạn copy con macro này & đè hoàn toàn lên macro cũ & thử xem nha
Chỉ có điều bất tiện là dữ liệu cộit 'B' dưới mã fải chép sang 'A'; Lý do thì bạn tự suy diễn ra nha.
PHP:
Option Explicit
Private Sub Worksheet_Change(ByVal Target As Range)
If Not Intersect(Target, Columns("B:B")) Is Nothing Then
If Target.Count > 1 Then Exit Sub
Dim Sh As Worksheet, Rng As Range, sRng As Range
Dim SoDòng As Long
Set Sh = Sheets("DuLieu")
Set Rng = Sh.Range(Sh.[b5], Sh.[B65500].End(xlUp))
Union(Target.Offset(, 1).Resize(22, 6), Target.Offset(, -1).Resize(22)).ClearContents
Set sRng = Rng.Find([b5].Value, , xlFormulas, xlWhole)
If sRng Is Nothing Then
MsgBox "Nothing"
Else
SoDòng = sRng.Offset(, -1).End(xlDown).Row - sRng.Row - 1
If SoDòng > 19 Then SoDòng = 19
'Chép Cot B Cua DuLieu Sang Cot A:'
Target.Offset(1, -1).Resize(SoDòng).Value = sRng.Offset(1).Resize(SoDòng).Value
Target.Offset(, 1).Resize(SoDòng, 6).Value = sRng.Offset(, 1).Resize(SoDòng, 6).Value
Cells(Target.Row + 1, "H").FormulaR1C1 = "=SUM(R[1]C:R[" & SoDòng & "]C)"
Cells(Target.Row + SoDòng + 1, "H").FormulaR1C1 = "=R[-" & SoDòng + 1 & "]C"
End If
End If
End SubChỉ có điều bất tiện là dữ liệu cộit 'B' dưới mã fải chép sang 'A'; Lý do thì bạn tự suy diễn ra nha.
Upvote
0
boyxin
Members actively
- Tham gia
- 10/3/08
- Bài viết
- 1,664
- Được thích
- 2,335
Có phải bạn muốn thế này (xem file đính kèm)
PHP:
Option Explicit
Private Sub Worksheet_Change(ByVal Target As Range)
If Not Intersect(Target, [b:b]) Is Nothing Then
Dim Sh As Worksheet, Rng As Range, fRng As Range, iR As Byte
Set Sh = Sheets("DuLieu")
Set Rng = Sh.Range(Sh.[b5], Sh.[B65500].End(xlUp))
If Not Rng.Find(Target, , xlValues, 1, 2) Is Nothing Then
Set fRng = Rng.Find(Target, , , 1, 2).Offset(, -1)
If fRng <> "" Then
If fRng.End(xlDown).Row = 65536 Then
iR = fRng.Offset(, 2).End(xlDown).Row - fRng.Row + 1
Else
iR = fRng.End(xlDown).Row - fRng.Row
End If
With Target.Resize(iR)
.Offset(, 1).Resize(, 6) = fRng.Offset(, 2).Resize(iR, 6).Value
.Resize(, 7).Borders.LineStyle = 1
.Resize(, 7).Borders(11).LineStyle = 1
.Resize(, 7).Borders(12).LineStyle = xlDot
End With
Target.Offset(2) = fRng.Offset(, 1).End(xlDown)
End If: End If
End If
End Sub
Upvote
0
MinhCong
Thành viên gắn bó
- Tham gia
- 28/5/09
- Bài viết
- 1,645
- Được thích
- 1,806
- Nghề nghiệp
- Xây dựng Cầu đường
Em thấy dường như chưa ổn Thầy SA_DQ ơi! Sao mã khác nhau mà nó lại lấy mã của cái thằng đầu tiên vậy thầy nhỉ?
VD: Mã cuối cùng bên sheet Dulieu 01.1094 -> Thành phần hao phí là: Phát tuyến loại III , mật độ cây tiêu chuẩn trên 100 m2, tương đối bằng phẳng, <=5 cây. Nhưng khi gõ mã hiệu bên sheet Hien thi thì nó vẫn là thành phần hao phí của 01.1054: Phát tuyến loại II , mật độ cây tiêu chuẩn trên 100 m2, tương đối bằng phẳng, <= 5 cây
Mong Thầy xem nhé!
Upvote
0
- Tham gia
- 8/6/06
- Bài viết
- 14,689
- Được thích
- 23,043
- Nghề nghiệp
- U80
Cảm ơn MinhCong đã fát hiện ra lỗi
& Lỗi là do nó tưởng đó là số dạng Double
Vì mình dùng câu lệnh này thì fát hiện ra:
Đành chờ tác giả topic có í kiến về việc này vậy!
& Lỗi là do nó tưởng đó là số dạng Double
Vì mình dùng câu lệnh này thì fát hiện ra:
PHP:
MsgBox Target.Value + 3.4, , sRng.Address & " " & sRng.Parent.NameĐành chờ tác giả topic có í kiến về việc này vậy!
Upvote
0
MinhCong
Thành viên gắn bó
- Tham gia
- 28/5/09
- Bài viết
- 1,645
- Được thích
- 1,806
- Nghề nghiệp
- Xây dựng Cầu đường
Em tìm ra vị trí sửa nó lại rồi Thầy ạ. Chỗ đây này:
Mã:
[COLOR=#000000][COLOR=#0000bb]Set sRng [/COLOR][COLOR=#007700]= [/COLOR][COLOR=#0000bb]Rng[/COLOR][COLOR=#007700].[/COLOR][COLOR=#0000bb]Find[/COLOR][COLOR=#007700]([[/COLOR][COLOR=#0000bb]b5[/COLOR][COLOR=#007700]].[/COLOR][COLOR=#0000bb]Value[/COLOR][COLOR=#007700], , [/COLOR][COLOR=#0000bb]xlFormulas[/COLOR][COLOR=#007700], [/COLOR][COLOR=#0000bb]xlWhole[/COLOR][COLOR=#007700])[/COLOR][/COLOR]
Mã:
[COLOR=#000000][COLOR=#0000bb]Set sRng [/COLOR][COLOR=#007700]= [/COLOR][COLOR=#0000bb]Rng[/COLOR][COLOR=#007700].[/COLOR][COLOR=#0000bb]Find[/COLOR][COLOR=#007700](Target[/COLOR][COLOR=#007700], , [/COLOR][COLOR=#0000bb]xlFormulas[/COLOR][COLOR=#007700], [/COLOR][COLOR=#0000bb]xlWhole[/COLOR][COLOR=#007700])[/COLOR][/COLOR]Mong Thầy xem giúp nhé!
Upvote
0
boyxin
Members actively
- Tham gia
- 10/3/08
- Bài viết
- 1,664
- Được thích
- 2,335
Xem thế này (trong file đính kèm) đã đạt yêu cầu chưa nhé
PHP:
Option Explicit
Private Sub Worksheet_Change(ByVal Target As Range)
If Not Intersect(Target, [b:b]) Is Nothing Then
Dim Sh As Worksheet, Rng As Range, fRng As Range, iR As Byte, iC As Byte
Set Sh = Sheets("DuLieu")
Set Rng = Sh.Range(Sh.[b5], Sh.[B65500].End(xlUp))
If Not Rng.Find(Target, , xlValues, 1, 2) Is Nothing Then
iC = Sh.[b5].End(xlToRight).Column - 2
Set fRng = Rng.Find(Target, , , 1, 2).Offset(, -1)
If fRng <> "" Then
If fRng.End(xlDown).Row = 65536 Then
iR = fRng.Offset(, 2).End(xlDown).Row - fRng.Row + 1
Else
iR = fRng.End(xlDown).Row - fRng.Row
End If
With Target.Resize(iR)
.Offset(1).Resize(iR - 1).EntireRow.Insert
fRng.Offset(, 2).Resize(iR, iC).Copy .Offset(, 1).Resize(, iC)
.Offset(, iC) = .Offset(, iC).Value
End With
Target.Resize(iR).Borders.LineStyle = 1
Target.Resize(iR).Borders(12).LineStyle = xlDot
Target.Offset(2) = fRng.Offset(, 1).End(xlDown)
End If: End If
End If
End Sub
Upvote
0
MinhCong
Thành viên gắn bó
- Tham gia
- 28/5/09
- Bài viết
- 1,645
- Được thích
- 1,806
- Nghề nghiệp
- Xây dựng Cầu đường
OK rồi, chỉ còn cái này nữa Anh xem xử lý giúp luôn nhé!
1/Bên sheet KL sao Em insert 1 dòng nữa nó lại BÁo lỗi nhỉ?
2/Nếu insert 1 dòng sau đó nhập 1mã hiệu khác thì số thứ tự nó không tự động nhập lại, Anh xem lại luôn nhé!
Thanks.
Upvote
0
boyxin
Members actively
- Tham gia
- 10/3/08
- Bài viết
- 1,664
- Được thích
- 2,335
Tại Sheet KL bạn bỏ code cũ. dùng code này xem sao nhé
PHP:
Option Explicit
Private Sub Worksheet_Change(ByVal Target As Range)
Dim Sh As Worksheet, iR As Long, eR As Long
Dim Rng As Range, fRng As Range, eRng As Range, clls As Range, sRng As Range
If Not Intersect(Target, [b:b]) Is Nothing Then
On Error Resume Next
Set Sh = Sheets("Dinhmuc")
Set Rng = Sh.Range(Sh.[B2], Sh.[B65500].End(xlUp))
If Target <> "" And Not Rng.Find(Target, , xlValues, 1, 2) Is Nothing Then
Set fRng = Rng.Find(Target, , xlValues, 1, 2)
Set eRng = fRng.End(xlDown): iR = fRng.Row
eR = IIf(eRng.Row > 65535, fRng.Offset(, 1).End(xlDown).Row, eRng.Row)
For Each clls In [b5].Resize([b6535].End(xlUp).Row - 4)
If clls <> "" Then
clls.Offset(, -1).FormulaR1C1 = "=COUNTA(r5c[1]:rc[1])"
clls.Offset(, -1) = clls.Offset(, -1).Value
Else
clls.Offset(, -1) = ""
End If
Next
Target.Offset(, 1).Resize(, 2) = Sh.Cells(iR, "C").Resize(, 2).Value
For Each clls In [g4:i4]
For Each sRng In fRng.Offset(, 1).Resize(eR - iR)
If InStr(sRng, clls) > 0 Then Cells(Target.Row, clls.Column) = sRng.End(xlToRight).Value
Next
Next
Else
With Target.Offset(, 1)
Union(.Offset(, -2), .Resize(, 2), .Offset(, 4).Resize(, 3)).ClearContents
End With
End If
End If
End Sub
Lần chỉnh sửa cuối:
Upvote
0
Sao mình làm trên file này không được nhỉ! Thôi mình có học được như các “Sư Phụ” thì còn lâu lắm! Mình muốn nhờ diễn đàn làm giúp mình luôn với file dữ liệu đính kèm!
* Trong bảng DuLieu có rât nhiều mã khác nhau, nếu muốn dùng mã nào thì chỉ cần nhập mã đó vào cột B của bảng Hienthi là nó hiện ra mã đó như Bác SA_QD, Boyxin và MinhCong làm đó, sau đó kết quả được tổng hợp vào một bảng Tonghop bên cạnh.
View attachment Tao vung du lieu.rar
* Trong bảng DuLieu có rât nhiều mã khác nhau, nếu muốn dùng mã nào thì chỉ cần nhập mã đó vào cột B của bảng Hienthi là nó hiện ra mã đó như Bác SA_QD, Boyxin và MinhCong làm đó, sau đó kết quả được tổng hợp vào một bảng Tonghop bên cạnh.
View attachment Tao vung du lieu.rar
Upvote
0
MinhCong
Thành viên gắn bó
- Tham gia
- 28/5/09
- Bài viết
- 1,645
- Được thích
- 1,806
- Nghề nghiệp
- Xây dựng Cầu đường
Sheet Dinhmuc là sheet phân tích đơn giá dự toán. Khi Bạn nhập mã hiệu bên sheet KL thì nó tự động dò tìm bên sheet Dinhmuc để cho ra đơn giá. Còn bên sheet PTVT khi Bạn chọn vào sheet này nó sẽ tự động phân tích vật tư cho Bạn. Bạn tải file sau về cập nhật định mức đơn giá cho sheet Dinhmuc (để làm sheet tổng dò tìm)
Upvote
0
ChanhTQ@
0901452không62
- Tham gia
- 5/9/08
- Bài viết
- 4,254
- Được thích
- 4,861
(1) Bạn bảo với chương trình là có lỗi thì đi tiếp;
Sau đó nó gặp lỗi không tìm thấy trang tính "Định Mức" gì gì đó thì nó thầm lặng tạm biệt bạn thôi.
(2) Các mã đó của ban rất khó trong viêc tìm kiếm; nó có thể hiểu là ngay tháng trong trường hợp như 12.12.19
hay là số kiểu Double như 01.2354
Nên tôi đã đổ lại hết mã công trình của bạn rồi; (Biếu bạn thêm macro còn trong nớ)
Bạn có thể không nhớ hết mã các công trình, nên tôi đã làm 1 ô Validation để bạn chọn mã;
Hình như còn gì đó mà đang lộn xôn; Bạn xem tiếp để chỉnh sửa nha
(3) Chưa rõ & hạ hồi fân giải . . .
Upvote
0
Sao trong file này, phần Định mức thì không nói rồi, nhưng bên sheet KL khi nhập số hiệu vào thì trong sheet tự động nhảy đơn giá của vật liệu, nhân công, ca máy. Mình muốn thay đổi đơn giá đó của bạn thành đơn giá ban hành theo tỉnh mình thì lại không thấy phần để thay đổi, còn Định mức thì hiện nay dùng chung định mức 1776 phải ko bạn?
Upvote
0
MinhCong
Thành viên gắn bó
- Tham gia
- 28/5/09
- Bài viết
- 1,645
- Được thích
- 1,806
- Nghề nghiệp
- Xây dựng Cầu đường
Không cần biết dùng định mức gì, Định mức 24, định mức 1776.....Bạn chỉ cần vào sheet Dinhmuc -> Cập nhật và chỉnh sửa theo định mức Bạn đang dùng -> Sau đó vào sheet KL nhập mã hiệu đơn giá của Bạn. (Bên sheet KL chẳng qua là khi Bạn nhập 1 mã hiệu nào đó thì nó sẽ dò tìm mã hiệu bên sheet Dinhmuc sau đó điền kết quả bên sheet KL)
Upvote
0
