Cần giúp đỡ viết hộ 1 code về công thức mảng! (1 người xem)

[alibaba2209]

Cần giúp đỡ viết hộ 1 code về công thức mảng!

em cần 1 code chạy tự động
1. khi thay đổi ngày ở A2 code sẽ tự động chạy
2. lấy dữ liễu ở cột E dồn sang cột F xếp từ trên xuống
3. lấy dữ liễu ở cột G dồn sang cột H xếp từ trên xuống

có file đính kèm bên dưới!
mong được giúp đỡ

 

[quanluu]

Cần giúp đỡ viết hộ 1 code về công thức mảng!

em cần 1 code chạy tự động
1. khi thay đổi ngày ở A2 code sẽ tự động chạy
2. lấy dữ liễu ở cột E dồn sang cột F xếp từ trên xuống
3. lấy dữ liễu ở cột G dồn sang cột H xếp từ trên xuống

có file đính kèm bên dưới!
mong được giúp đỡ

Mình chẳng thấy cái nào theo ngày cả, vậy thì A2 có cũng bang thừa.

 

[alibaba2209]

Mình chẳng thấy cái nào theo ngày cả, vậy thì A2 có cũng bang thừa.

có mà anh ơi!...........................
Nghĩa là khi giữ liệu ở ô A2 thay đổi code sẽ tự động chạy

 

[alibaba2209]

không có bác nào giúp em à!

 

[quanluu]

không có bác nào giúp em à!

Cái vô lý ở đây là date chẳng có liên quan đến vấn đề tổng hợp dữ lieu ấy. Nếu tôi nhập ở A2 giá trị ko phải là ngày thì sao? chứ cái này thì vài dòng là xong.

 

[alibaba2209]

Cái vô lý ở đây là date chẳng có liên quan đến vấn đề tổng hợp dữ lieu ấy. Nếu tôi nhập ở A2 giá trị ko phải là ngày thì sao? chứ cái này thì vài dòng là xong.

Sub CTMang()

Sheets("Dau ra nhat ky").Select
Dim arr, arrF, arrH, ar As Variant, i, f, h As Long

Union([F2:F9999], [H2:H9999]).ClearContents 'Xoa giu lieu vung
arr = [E2:G9999] 'Vùng giu lieu E bat dau la cot 1
ReDim arrF(1 To UBound(arr), 1 To 1), arrH(1 To UBound(arr), 1 To 1)
For i = 1 To UBound(arr)
If arr(i, 1) <> "" Then f = f + 1: arrF(f, 1) = arr(i, 1) 'Cot lay giu lieu E cho F la cot 1
If arr(i, 3) <> "" Then h = h + 1: arrH(h, 1) = arr(i, 3) 'Cot lay giu lieu G cho H la cot 3
Next
[F2:F9999] = arrF 'Chuyen giu lieu sang vung
[H2:H9999] = arrH
End Sub

- làm sao bỏ cái tính toán được anh nhỉ, mỗi lần chạy code nó cứ nháy nháy chậm bảng tính quá
đây anh ơi file đính kèm dưới đây next lên cái giữ lieu cột E và cột G thay đổi

 

[quanluu]

Sub CTMang()

Sheets("Dau ra nhat ky").Select
Dim arr, arrF, arrH, ar As Variant, i, f, h As Long

Union([F2:F9999], [H2:H9999]).ClearContents 'Xoa giu lieu vung
arr = [E2:G9999] 'Vùng giu lieu E bat dau la cot 1
ReDim arrF(1 To UBound(arr), 1 To 1), arrH(1 To UBound(arr), 1 To 1)
For i = 1 To UBound(arr)
If arr(i, 1) <> "" Then f = f + 1: arrF(f, 1) = arr(i, 1) 'Cot lay giu lieu E cho F la cot 1
If arr(i, 3) <> "" Then h = h + 1: arrH(h, 1) = arr(i, 3) 'Cot lay giu lieu G cho H la cot 3
Next
[F2:F9999] = arrF 'Chuyen giu lieu sang vung
[H2:H9999] = arrH
End Sub

- làm sao bỏ cái tính toán được anh nhỉ, mỗi lần chạy code nó cứ nháy nháy chậm bảng tính quá
đây anh ơi file đính kèm dưới đây next lên cái giữ lieu cột E và cột G thay đổi

Code của bạn mình thấy ok rùi đó.
để cho ko bị nháy thì bạn dung application.screenupdating

 

[alibaba2209]

Code của bạn mình thấy ok rùi đó.
để cho ko bị nháy thì bạn dung application.screenupdating

Sub CTMang()

Sheets("Dau ra nhat ky").Select
Dim arr, arrF, arrH, ar As Variant, i, f, h As Long

getSpeed (True)
Union([F2:F9999], [H2:H9999]).ClearContents 'Xoa giu lieu vung
arr = [E2:G9999] 'Vùng giu lieu E bat dau la cot 1
ReDim arrF(1 To UBound(arr), 1 To 1), arrH(1 To UBound(arr), 1 To 1)
For i = 1 To UBound(arr)
If arr(i, 1) <> "" Then f = f + 1: arrF(f, 1) = arr(i, 1) 'Cot lay giu lieu E cho F la cot 1
If arr(i, 3) <> "" Then h = h + 1: arrH(h, 1) = arr(i, 3) 'Cot lay giu lieu G cho H la cot 3
Next
[F2:F9999] = arrF 'Chuyen giu lieu sang vung
[H2:H9999] = arrH
getSpeed (False)

End Sub
Function getSpeed(doIt As Boolean)
Application.ScreenUpdating = Not (doIt)
Application.EnableEvents = Not (doIt)
Application.Calculation = IIf(doIt, xlCalculationManual, xlCalculationAutomatic)

End Function

Như này được không bạn!
>> Giờ làm thế nào cho code chạy tự động được nhỉ theo ý trên của mình ý, ngày chuyển sang ngày khác thì giữ lieu cột E và G thay đổi code tự động chạy để update

 

[quanluu]

Sub CTMang()

Sheets("Dau ra nhat ky").Select
Dim arr, arrF, arrH, ar As Variant, i, f, h As Long

getSpeed (True)
Union([F2:F9999], [H2:H9999]).ClearContents 'Xoa giu lieu vung
arr = [E2:G9999] 'Vùng giu lieu E bat dau la cot 1
ReDim arrF(1 To UBound(arr), 1 To 1), arrH(1 To UBound(arr), 1 To 1)
For i = 1 To UBound(arr)
If arr(i, 1) <> "" Then f = f + 1: arrF(f, 1) = arr(i, 1) 'Cot lay giu lieu E cho F la cot 1
If arr(i, 3) <> "" Then h = h + 1: arrH(h, 1) = arr(i, 3) 'Cot lay giu lieu G cho H la cot 3
Next
[F2:F9999] = arrF 'Chuyen giu lieu sang vung
[H2:H9999] = arrH
getSpeed (False)

End Sub
Function getSpeed(doIt As Boolean)
Application.ScreenUpdating = Not (doIt)
Application.EnableEvents = Not (doIt)
Application.Calculation = IIf(doIt, xlCalculationManual, xlCalculationAutomatic)

End Function

Như này được không bạn!
>> Giờ làm thế nào cho code chạy tự động được nhỉ theo ý trên của mình ý, ngày chuyển sang ngày khác thì giữ lieu cột E và G thay đổi code tự động chạy để update

thì bạn dung sự kiện worksheet_change, if target.address = "$A$2" then .....

 

[alibaba2209]

thì bạn dung sự kiện worksheet_change, if target.address = "$A$2" then .....

Làm ơn thêm hộ mình đoạn code đó vào với ạ!

 

[quanluu]

Làm ơn thêm hộ mình đoạn code đó vào với ạ!

Trời, trong sheet them 3 dòng code này thui mà

Private Sub Worksheet_Change(ByVal Target As Range)
    If Target.Address = "$A$2" Then Call CTMang
End Sub

 

[alibaba2209]

Trời, trong sheet them 3 dòng code này thui mà

Private Sub Worksheet_Change(ByVal Target As Range)
    If Target.Address = "$A$2" Then Call CTMang
End Sub

Sub CTMang()
Sheets("Dau ra nhat ky").Select
Dim arr, arrF, arrH, ar As Variant, i, f, h As Long

getSpeed (True)
Union([F2:F9999], [H2:H9999]).ClearContents 'Xoa giu lieu vung
arr = [E2:G9999] 'Vùng giu lieu E bat dau la cot 1
ReDim arrF(1 To UBound(arr), 1 To 1), arrH(1 To UBound(arr), 1 To 1)
For i = 1 To UBound(arr)
If arr(i, 1) <> "" Then f = f + 1: arrF(f, 1) = arr(i, 1) 'Cot lay giu lieu E cho F la cot 1
If arr(i, 3) <> "" Then h = h + 1: arrH(h, 1) = arr(i, 3) 'Cot lay giu lieu G cho H la cot 3
Next
[F2:F9999] = arrF 'Chuyen giu lieu sang vung
[H2:H9999] = arrH
getSpeed (False)
End Sub


Function getSpeed(doIt As Boolean)
Application.ScreenUpdating = Not (doIt)
Application.EnableEvents = Not (doIt)
Application.Calculation = IIf(doIt, xlCalculationManual, xlCalculationAutomatic)
End Function


Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Address = "$A$2" Then Call CTMang
End Sub
sao vẫn bị lỗi nhỉ bạn ơi "Compile error - A module is not valid type"

 

[quanluu]

Sub CTMang()
Sheets("Dau ra nhat ky").Select
Dim arr, arrF, arrH, ar As Variant, i, f, h As Long

getSpeed (True)
Union([F2:F9999], [H2:H9999]).ClearContents 'Xoa giu lieu vung
arr = [E2:G9999] 'Vùng giu lieu E bat dau la cot 1
ReDim arrF(1 To UBound(arr), 1 To 1), arrH(1 To UBound(arr), 1 To 1)
For i = 1 To UBound(arr)
If arr(i, 1) <> "" Then f = f + 1: arrF(f, 1) = arr(i, 1) 'Cot lay giu lieu E cho F la cot 1
If arr(i, 3) <> "" Then h = h + 1: arrH(h, 1) = arr(i, 3) 'Cot lay giu lieu G cho H la cot 3
Next
[F2:F9999] = arrF 'Chuyen giu lieu sang vung
[H2:H9999] = arrH
getSpeed (False)
End Sub


Function getSpeed(doIt As Boolean)
Application.ScreenUpdating = Not (doIt)
Application.EnableEvents = Not (doIt)
Application.Calculation = IIf(doIt, xlCalculationManual, xlCalculationAutomatic)
End Function


Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Address = "$A$2" Then Call CTMang
End Sub
sao vẫn bị lỗi nhỉ bạn ơi "Compile error - A module is not valid type"

2 cái đầu để trong mudule, cái cuối là sự kiên của worksheet, nên nó nằm trong sheet mình làm việc. Hic

 

[alibaba2209]

2 cái đầu để trong mudule, cái cuối là sự kiên của worksheet, nên nó nằm trong sheet mình làm việc. Hic

Đây bạn ơi! nó không hoạt động!

 

[alibaba2209]

2 cái đầu để trong mudule, cái cuối là sự kiên của worksheet, nên nó nằm trong sheet mình làm việc. Hic

file đính kèm đây! bạn làm ơn xem dùm lại với.. giúp cho chót đi. vào file xem code được chưa và add dùm với mình làm mãi ko chạy @@

 

[quanluu]

file đính kèm đây! bạn làm ơn xem dùm lại với.. giúp cho chót đi. vào file xem code được chưa và add dùm với mình làm mãi ko chạy @@

A2 là công thức nên bạn bỏ cái worksheet_change, thay bang cái này

Private Sub Worksheet_Calculate()
    Static oldval
    If Range("A2").Value <> oldval Then
        oldval = Range("A2")
        Call AutoNhatKy
    End If
End Sub

 

[alibaba2209]

A2 là công thức nên bạn bỏ cái worksheet_change, thay bang cái này

Private Sub Worksheet_Calculate()
    Static oldval
    If Range("A2").Value <> oldval Then
        oldval = Range("A2")
        Call AutoNhatKy
    End If
End Sub

Mình xin chân thành cảm ơn bạn nhiều! code chạy ngon rồi ạ

 

[alibaba2209]

A2 là công thức nên bạn bỏ cái worksheet_change, thay bang cái này

Private Sub Worksheet_Calculate()
    Static oldval
    If Range("A2").Value <> oldval Then
        oldval = Range("A2")
        Call AutoNhatKy
    End If
End Sub

Mình còn 1 vấn đề nữa xin hỏi bạn. Nếu mình đang ở 1 Sheet "List nhat ky" link với ô A2 ở Sheet đó khi thay đổi Code chạy nó ko bị mở sang Sheet "Dau ra nhat ky" được không ạ!

 

[quanluu]

Mình còn 1 vấn đề nữa xin hỏi bạn. Nếu mình đang ở 1 Sheet "List nhat ky" link với ô A2 ở Sheet đó khi thay đổi Code chạy nó ko bị mở sang Sheet "Dau ra nhat ky" được không ạ!

Không hiểu ý bạn là ntn????

 

[alibaba2209]

Không hiểu ý bạn là ntn????

Khi mình đang đứng tại sheet khác..code chạy nó lại quay lại sheet cái sheet chạy code. Có cách nào chạy code mà ko bị quay lại sheet đó ko