Tạo mối quan hệ giữa 2 sheet !! Giúp em với ạ

bes · 5/12/06

Các anh chị giúp em với :

1. ở sheet1 em có 1 bảng với cột A là giá trị ngày tháng năm đưa vào.
ở sheet2 em có cái bảng tương tự nhưng chỉ muốn những hàng nào mà bên sheet1 là trống thì đưa vào, còn nếu có giá trị not null rồi thì thôi. Có nghĩa là sheet1 có 100 hàng nhưng chỉ 10 hàng trống giá trị ngày tháng năm thì sheet2 tự động xuất hiện 10 hàng đó thôi.
2. Nếu sheet1 thêm 1 hàng hay xoá 1 hàng thì đều được phản ảnh trên sheet2. Ví dụ như trong 10 hàng trống của sheet1 xoá đi 1 hàng thì sheet2 tự động bớt đi hàng đó. Tương tự như vậy đối với thêm 1 hoặc nhiều hàng.

Hiện nay em chỉ biết làm thủ công là link từ sheet2 sang sheet1, sau đó dùng filter lọc lấy những hàng có giá trị trống và xoá bỏ những hàng còn lại. Tuy nhiên việc thêm bớt hàng ở sheet1 thì không cập nhật được ở sheet2. Nếu xoá thì nó báo REF#, còn thêm thì nó không biết.
Các anh chị giúp em với ạ, bằng cách nào đơn giản 1 chút .
Em cảm ơn rất rất nhiều.

Bes.

Mr Okebab · 6/12/06

Bạn có thể up file lên được không ?

bes · 6/12/06

Em gửi file ví dụ như thế ạ, gốc là sheet1, kết quả ở sheet2.
Cảm ơn các anh chị đã(sẽ) giúp đỡ.

SA_DQ · 6/12/06

Nhiệm vụ một, như sau:

Bôi đi &ì được trích dẫn hoàn toàn fía dưới!

ThuNghi · 6/12/06

Theo tôi bạn tạo 1 macro add thêm sh1 và sort theo cột A là nhanh nhất khi bạn có thay đổi ở sh1

bes · 6/12/06

SA_DQ đã viết:
Bạn phải chuột vô sheet1 trên thanh SheetName (Sh nhập liệu) chọn hàng cuối: View Code & nhập Sub này vô nó

Mã:

Option Explicit[B] Private Sub Worksheet_Change(ByVal Target As Range)[/B] If Not Intersect(Range("B:B"), Target) Is Nothing Then If Target.Offset(0, -1).Value = "" Then End If: End If Rows(Target.Row).EntireRow.Copy Destination:=Sheets("s2").Range("B65536").End(xlUp).Offset(0, -1) [B]End Sub [/B]

Giải thích thêm tẹo:
khi nhập mới vô cột 'B' nhưng để trống ô tại cột 'A' thì sẽ chép nguyên hàng của sh này đem sang chép vô hàng cuối của 'S2'
(Tất nhiên việc nhập vô cột 'B' này hình như trái tập quán. &ậy bạn cần sửa lại code cho thích hợp hơn, nếu không dám sửa thì nêu iêu cầu, chúng ta cùng sửa!
Mvụ 2 theo mình nghỉ: nên tạo nút lệnh gán macro vô để nó làm MVụ xóa 2 hàng ở 2 Sh luôn! Nếu chịu vậy sẽ bàn tiếp!

Em đưa đoạn code trên vào rồi nhưng nó không ghi được vào macro nên không biết chạy thế nào cả hu,...hu.....

bes · 6/12/06

Anh SA_QD !

Cảm ơn anh rất nhiều, em thử và thấy kết quả rồi. Tuy nhiên còn một chút này nữa mong anh sửa giúp em cho hoàn thiện hơn.

* Trường hợp số cuối dòng lệnh cuối là 1:
Vì file ví dụ em đưa chỉ có 2 cột thôi nên code anh tặng em cực kỳ chuẩn. Nhưng file thật của em có 10 cột tất cả nên dẫn đến khi nhập liệu ở cột a bên sheet kết quả tạo thành 1 dòng, nhập ở cột b tạo thêm 1 dòng và cứ thế cho đến hết. Em muốn code nhận biết được là trong 10 cột đó nếu chỉ cột I để trống thì mới copy sang sheet kết quả. Có được không anh?

* Trường hợp số cuối dòng lệnh cuối là 0:
Kết quả hiển đẹp mỗi tội chép lên dòng cũ - công toi.

* Trường hợp em paste 1 đoạn nhiều dòng thì chương trình báo error
Runtime error '1004'

* Và thêm 1 cái cuối cùng là nếu ở sheet gốc em nhập liệu vào cái ô trống (điều kiện để copy sang sheet kết quả) thì bên sheet kết quả sẽ tự động xoá dòng đó đi. Có được không ạ?

Em gửi lại 1 đoạn file chuẩn, anh giúp em với ạ.

SA_DQ · 7/12/06

/(/)ình đã thêm các dòng lệnh mới tại #4, dùng cái mới để trao đổi nha!

Mong anh sửa giúp em cho hoàn thiện hơn.
* Trường hợp số cuối dòng lệnh cuối là 1:
Vì file ví dụ em đưa chỉ có 2 cột thôi nên code anh tặng em cực kỳ chuẩn. Nhưng file thật của em có 10 cột tất cả nên dẫn đến khi nhập liệu ở cột a bên sheet kết quả tạo thành 1 dòng, nhập ở cột b tạo thêm 1 dòng và cứ thế cho đến hết. Em muốn code nhận biết được là trong 10 cột đó nếu chỉ cột I để trống thì mới copy sang sheet kết quả. Có được không anh?

Về việc này mình đã cảnh báo ngay từ bài đầu là trong thực tế phải nhập đến cuối dòng mới xét đến việc copy hay không copy (Đ/K ô A của dòng là trống)
Bạn xem ở dòng 2: thay vì 'B:B' bạn thay cột cuối của bạn cho thích hợp
Mình GT luôn dòng lệnh, để sau này bạn tự bảo trì/SChửa: Nếu ô đang nhập liệu không khác với ~ ô trong cột 'X:X' thì thực hiện lệnh tiếp;
(Như vậy ở đây bạn sửa lại là 'J:J' hay 'K:K' theo CSDL của bạn). & bạn phải sửa lại dòng lệnh kế tiếp (3) xem ô A1 (ô kiểm trống) cách ô nhập cuối này mấy ô & bảo cho excel biết để còn lùi lại)
Mình xin dịch câu lệnh (3) như sau: Nếu ô trái kế bên là trống thì thực hiện dòng lệnh (5)

* Trường hợp em paste 1 đoạn nhiều dòng thì chương trình báo error
Runtime error '1004'

Đúng là khi cài chw trình xong mà muốn xóa dòng trong Sheet nhapLieu nó sẽ báo lỗi; mình đã thêm các dòng lệnh bắt lỗi 1004 này (dòng 1 & các dòng>5); nếu chưa suông sẽ thì báo nha!

* Và thêm 1 cái cuối cùng là nếu ở sheet gốc em nhập liệu vào cái ô trống (điều kiện để copy sang sheet kết quả) thì bên sheet kết quả sẽ tự động xoá dòng đó đi. Có được không ạ?

Hoàn tất: chiều 8/12/06

Mã:

Option Explicit[B]
Private Sub Worksheet_Change(ByVal Target As Range)[/B]
 1 On Error GoTo Loi_WChange
2    If Not Intersect(Range("B:B"), Target) Is Nothing Then
3        If Target.Offset(0, -1).Value = "" Then
4           Rows(Target.Row).EntireRow.Copy Destination:=Sheets("s2").Range("B65536").End(xlUp).Offset(1, -1)
5  End If:                       Exit Sub:                                   End If

6  If Not Intersect(Range("A:A"), Target) Is Nothing Then
7       If Target.Value <> "" And Target.Offset(0, 1).Value <> "" Then
8           Dim Xoa As Boolean:               Dim Strc As String
9            Xoa = True:        Strc = Target.Address
10 End If:                 End If
11 Strc = Strc & ":J" & Mid(Strc, 4)
12 If Xoa Then
14      Dim Rng10 As Range, Rng As Range:       Set Rng10 = Range(Strc)
15      Dim ij As Integer:                                                  ij = 1
16      For Each Rng In Rng10
17          MangDL(ij) = Rng.Value:                                 ij = 1 + ij
18      Next Rng
19 End If
20 Run "Xoa1Dong"
Err_WChange:             Exit Sub
Loi_WChange:
    Select Case Err
    Case 1004
        Exit Sub
    Case Else:
        MsgBox Error$, , Str(Erl):                      Resume Err_WChange
    End Select
[b]end Sub[/b]

SA_DQ · 7/12/06

)(ong rồi đây!

1. Thử chép dòng từ Sheet1 -> 'S2' trước;
= cách nhập 1 dấu '.' hay dấu ',' vô ô cột 'J:J' mà ô trước nó trống dữ liệu

2./ Xóa dòng khi nhập vô cột 'Sheet1'!"I:I" dữ liệu bất kỳ <> ""
( của bạn hình như nhập ngày)

bes · 7/12/06

Chà chà, anh SA_QD là cao thủ rồi chứ còn đâu nữa. Hôm nay em vào đọc mấy bài chập chững vào VBA của anh mà thấy choáng, ngưỡng mộ cực kỳ luôn.
Cảm ơn anh rất rất nhiều. Em sẽ thử, nếu có vấn đề gì em lại lại phiền anh tiếp đấy

bes · 7/12/06

Anh ơi, báo lỗi MangDL(Ij) chưa được khai báo !!!

Mã:

Option Explicit
Private Sub Worksheet_Change(ByVal Target As Range)
1  On Error GoTo Loi_WChange
2    If Not Intersect(Range("J:J"), Target) Is Nothing Then
3        If Target.Offset(0, -1).Value = "" Then
4           Rows(Target.Row).EntireRow.Copy Destination:=Sheets("test").Range("B65536").End(xlUp).Offset(1, -1)
5  End If:                       Exit Sub:                                   End If

6  If Not Intersect(Range("A:A"), Target) Is Nothing Then
7       If Target.Value <> "" And Target.Offset(0, 1).Value <> "" Then
8           Dim Xoa As Boolean:               Dim Strc As String
9            Xoa = True:        Strc = Target.Address
10 End If:                 End If
11 Strc = Strc & ":K" & Mid(Strc, 4)
12 If Xoa Then
14      Dim Rng10 As Range, Rng As Range:       Set Rng10 = Range(Strc)
15      Dim Ij As Integer:                                                  Ij = 1
16      For Each Rng In Rng10
[COLOR=Red]17          [B]MangDL(Ij) = Rng.Value:[/B]                                 Ij = 1 + Ij [I](Sub or Funtion not defined)[/I][/COLOR]
18      Next Rng
19 End If
Err_WChange:             Exit Sub
Loi_WChange:
    Select Case Err
    Case 1004
        Exit Sub
    Case Else:                                                                  Resume Err_WChange
    End Select
End Sub

Em compile thấy nó báo lỗi ở đây anh ạ, anh check giùm em xem phần code em chỉnh lại như thế đã đúng chưa nhé.
Cái tham số Range("B65536") ở dòng code 4 là gì thế hả anh, em có cần thay bằng ("J65536") không ạ?

bes · 9/12/06

OK rồi anh ạ, nhưng trường hợp paste nhiều dòng thì chưa có tác dụng.
Trong code của anh làm cho em em thấy có 2 phần (worksheet_Change) và Xoa1dong(MangDL), nhưng khi em copy code để đưa sang file khác thì chỉ được 1 thôi (Worksheet_Change). Để add được nhiều sub vào code thì phải làm thế nào ạ? (Hôm trước em thấy có bài anh hướng dẫn em, hôm nay tìm lại thì chắc anh edit mất rùi)

SA_DQ · 9/12/06

OK rồi anh ạ, nhưng trường hợp paste nhiều dòng thì chưa có tác dụng.

/)/(ình làm cho kiểu nhập liệu: nghĩa là từng dòng;
Còn chép nhiều dòng thì đợi nhen! nhưng chép từ đâu? & chép như thế nào? cho mình biết nha!

Trong code của anh làm, em thấy có 2 phần (worksheet_Change) và Xoa1dong(MangDL), nhưng khi em copy code để đưa sang file khác thì chỉ được 1 thôi (Worksheet_Change). Để add được nhiều sub vào code thì phải làm thế nào ạ? (Hôm trước em thấy có bài anh hướng dẫn em, hôm nay tìm lại thì chắc anh edit mất rùi)

(hưa rõ lắm về câu hỏi; có lẽ vầy:
Bạn chưa biết Sub Xoa1Dong nằm ở đâu, chứ zì?
Hãy nhấn tổ hợp fím ALT +{F8} Hay ALT +{F11} xem sao?
(Mình có ghi một dòng lệnh như sau trong CS VBA trước, nhằm để định vị mà: Sub Macro1: End Sub). . . Xem lại nha!

bes · 9/12/06

Thank you very much !!!

SA_DQ đã viết:
/)/(ình làm cho kiểu nhập liệu: nghĩa là từng dòng;
Còn chép nhiều dòng thì đợi nhen! nhưng chép từ đâu? & chép như thế nào? cho mình biết nha!

(hưa rõ lắm về câu hỏi; có lẽ vầy:
Bạn chưa biết Sub Xoa1Dong nằm ở đâu, chứ zì?
Hãy nhấn tổ hợp fím ALT +{F8} Hay ALT +{F11} xem sao?
(Mình có ghi một dòng lệnh như sau trong CS VBA trước, nhằm để định vị mà: Sub Macro1: End Sub). . . Xem lại nha!

đúng cái này rồi, hôm trước em đã thấy anh nói về cái Alt+F8 ở một cái bài nào đó sau anh edit mất tiêu . Cảm ơn anh, em chạy tốt lắm rồi - bây giờ công việc đã thuận tiện hơn rất nhiều. Khi nào anh rảnh rỗi thì xem nốt hộ em phần paste nhiều dòng nhé. Bọn em dùng 1 cái soft khi kết xuất ra là 1 cái bảng tương tự như file em gửi anh. Thông thường em sẽ copy hết cái file đó và paste vào cái file gốc để theo dõi, nhiều lắm mỗi ngày có vài chục hàng cơ - nếu mà em nhập tay vào từng cái 1 thì lâu lắm và sợ rằng không chính xác do làm thủ công. Hiện nay em ghi lại 1 cái macro là copy toàn bộ s1 sang s2 --> filter ---> lọc bản ghi not blank ----> xoá ---> sắp xếp theo yêu cầu . Nói chung dùng cũng ổn, mỗi tội cứ chạy macro là nó ghi đè hết lên dữ liệu cũ ở s2 - phải chấp nhận thôi vì khó hơn em không làm được. Bây giờ thêm cái Xoa1dong của anh nữa là em thấy ổn lắm rồi.
Cảm ơn anh SA_DQ rất rất nhiều.
Chúc anh weekend vui vẻ và ấm áp . Hà Nội mấy hôm nay trở lạnh rồi !!!

SA_DQ · 12/12/06

Phần cuối đây: Gởi bạn thay quà noel

Mã:

[b]Sub CopyRows()[/b]
Dim Rng As Range, rRrr As Range
Set Rng = Selection:                    ij = 0
For Each rRrr In Rng
    If rRrr.Offset(0, 1).Value <> "" And rRrr.Value = "" Then
        Rows(rRrr.Row).EntireRow.Copy Destination:=Sheets("s2").Range("A65536").End(xlUp).Offset(1, 0)
        MauNen rRrr, ij:
        ij = 1 + ij
    End If
Next rRrr
MsgBox "Copy " & Str(ij) & " Row" & IIf(ij > 1, "s", "")
[b]End Sub

Sub MauNen(Rrwzj As Range, jz As Integer)[/b]
    Dim wZ As Integer
    wZ = jz Mod 6:                      wZ = wZ + 34
    With Rrwzj.Interior
        .ColorIndex = wZ:                                         .Pattern = xlSolid
    End With
[b]End Sub[/b]

(ách sử dụng:
Đây là đoạn code để chép nhiều hàng trống tại cột 'J' sang sheets('S2')
Sau khi bạn chép xong dữ liệu vô Sheet1
Bạn dùng chuột tô cột 'J' với ~ ô bạn muốn copy dòng trống sang S2 & nhấn tổ hợp phím bạn đã gán cho macro CopyRows
Macro sẽ copy chỉ ~ dòng trống Intersect với ~ ô đã chọn!

bes · 12/12/06

Em cảm ơn anh nha, mấy hôm bận quá nên bây giờ em mới vào được đây.
Chúc anh Giáng Sinh An Lành !!!

SA_DQ · 13/12/06

To TanHaiKSTH: Bạn này chắc gởi nhằm chỗ?!

Nguyên văn bởi tanhaiksth Hi! All
Hiện tại mình đang co hai worksheets và có 2 sheet trong 2 worksheets đó. Mình muốn link dử liệu giữa 2 sheet trong 2 worksheets với nhau:
- Muốn cột A5:f100 ở sheet1 của worksheet1 khi có dử liệu thì tự động sẽ được link sang cột A5:f100 sheet1 của worksheet2.
(Mong các bạn giải bài này bằng VBA để mình hiểu )

Bạn phải chuột & chép đoạn code sau đây vô cửa sổ codeName (xem bài trước trong đề mục này):

Mã:

[b]Private Sub Worksheet_Change(ByVal Target As Range)[/b]
    If Not Intersect(Target, Range("A5:F99")) Is Nothing Then
        With Target
            ChepTU .Address, .Value
        End With
    End If
[b]End Sub[/b]

Sau đó chép đoạn code này vô cửa sổ module1:

Mã:

[b] Sub ChepTU(Targt As String, Val1 As Variant)[/b]
        Sheets("S9").Select
       Range(Targt).Value = Val1
       Sheets("S0").Select
[b]End Sub[/b]

Chú ý nhỏ: 'S0' là sheet chủ động; còn 'S9' thì ngược lại!

SA_DQ · 14/12/06

Thay món quà khác cho BES đây

Để cải thiện tốc độ khi chép nhiều dòng!

Mã:

 [b] Sub CopyRows() [/b]
    Dim UniRange As Range, Rng As Range:                Dim iZ As Long
    For Each Rng In Selection
        With Rng
            If .Value = "" And .Offset(0, 1).Value <> "" Then
                iZ = .Row
                If UniRange Is Nothing Then
                    Set UniRange = .EntireRow
                Else
                    Set UniRange = Application.Union(UniRange, .EntireRow)
            End If:                                         End If
        End With
    Next Rng
    Range("I" & iZ).Interior.ColorIndex =( iZ Mod 6) + 34
    UniRange.Copy Destination:=Sheets("S2").Range("A65536").End(xlUp).Offset(1, 0)
[b] Exit Sub:               End Sub [/b]

Theo mình tốc độ sẽ cải thiện nhiều, khi cần chép nhiều dòng một lúc!

Tạo mối quan hệ giữa 2 sheet !! Giúp em với ạ

Thành viên mới

Ngon Ngất Ngây

Thành viên mới

File đính kèm

/(hông là gì!

Hãy cho rồi sẽ nhận!

Thành viên mới

Thành viên mới

File đính kèm

/(hông là gì!

/(hông là gì!

Thành viên mới

Thành viên mới

Thành viên mới

/(hông là gì!

Thành viên mới

/(hông là gì!

Thành viên mới

/(hông là gì!

/(hông là gì!

Facebook

Group