Chèn dòng tổng cộng và tính tổng (1 người xem)

hong1989 · 18/8/15

Mình xin gửi file lên mong các thành viên giúp đỡ. Yêu cầu mình đã viết chi tiết trong file. Cám ơn mọi người
Linhk file:
https://drive.google.com/file/d/0Bx6z3YcGDvh7Q2F5OUdDbXA3VW8/view?pli=1

SA_DQ · 18/8/15

PHP:

Option Explicit
Sub Copy()
Dim Arr(), dArr(1 To 65536, 1 To 5)
Dim TD As Double, TE As Double, TF As Double, I, J, K

With Sheet1
    Arr = .Range("C7", .[C65000].End(xlUp)).Resize(, 16).Value
End With
For I = 1 To UBound(Arr, 1)
    If Arr(I, 7) = Cells(3, 3) Then
        K = K + 1
        dArr(K, 1) = K
        dArr(K, 2) = Arr(I, 1)
        dArr(K, 3) = Arr(I, 7)
        TD = TD + Arr(I, 7)                     '|'
        dArr(K, 4) = Arr(I, 11)
        TE = TE + Arr(I, 11)                    '|'
        dArr(K, 5) = Arr(I, 9) / 1000
        TF = TF + dArr(K, 5)                    '|'
    End If
Next I
dArr(K + 1, 2) = Sheets("Input").[a3].Value         '+'
dArr(K + 1, 3) = TD:        dArr(K + 1, 4) = TE     '+'
dArr(K + 1, 5) = TF                                 '+'
With Sheet4
    .Range("B9:F5000").ClearContents
    .Range("B9").Resize(K + 2, 5) = dArr            '|'
End With
End Sub

doveandrose · 18/8/15

hong1989 đã viết:
Mình xin gửi file lên mong các thành viên giúp đỡ. Yêu cầu mình đã viết chi tiết trong file. Cám ơn mọi người
Linhk file:
https://drive.google.com/file/d/0Bx6z3YcGDvh7Q2F5OUdDbXA3VW8/view?pli=1

nhỏ hơn 5 bỏ qua rồi lớn hơn 5 có lấy không ?

hong1989 · 18/8/15

HYen17 đã viết:

PHP:

Option Explicit
Sub Copy()
Dim Arr(), dArr(1 To 65536, 1 To 5)
Dim TD As Double, TE As Double, TF As Double, I, J, K

With Sheet1
    Arr = .Range("C7", .[C65000].End(xlUp)).Resize(, 16).Value
End With
For I = 1 To UBound(Arr, 1)
    If Arr(I, 7) = Cells(3, 3) Then
        K = K + 1
        dArr(K, 1) = K
        dArr(K, 2) = Arr(I, 1)
        dArr(K, 3) = Arr(I, 7)
        TD = TD + Arr(I, 7)                     '|'
        dArr(K, 4) = Arr(I, 11)
        TE = TE + Arr(I, 11)                    '|'
        dArr(K, 5) = Arr(I, 9) / 1000
        TF = TF + dArr(K, 5)                    '|'
    End If
Next I
dArr(K + 1, 2) = Sheets("Input").[a3].Value         '+'
dArr(K + 1, 3) = TD:        dArr(K + 1, 4) = TE     '+'
dArr(K + 1, 5) = TF                                 '+'
With Sheet4
    .Range("B9:F5000").ClearContents
    .Range("B9").Resize(K + 2, 5) = dArr            '|'
End With
End Sub

Bạn ơi cột C chưa có chữ tổng cộng và có thể kẻ thêm viền ô khi chạy code không?

hong1989 · 18/8/15

doveandrose đã viết:
nhỏ hơn 5 bỏ qua rồi lớn hơn 5 có lấy không ?

Điều kiện là bằng ô C3 ở sheet "input". cho mình thêm chút là kẻ thêm viền kẻ khi chạy code cho những ô thỏa man điều kiện nhé

doveandrose · 18/8/15

hong1989 đã viết:
Điều kiện là bằng ô C3 ở sheet "input". cho mình thêm chút là kẻ thêm viền kẻ khi chạy code cho những ô thỏa man điều kiện nhé

được hết . cứ chờ thầy HYen17 là có hết

hong1989 · 18/8/15

doveandrose đã viết:
được hết . cứ chờ thầy HYen17 là có hết

Thầy HYen17 off rồi trong lúc chờ đợi bạn có thể viết để test thử trước được không

hong1989 · 18/8/15

hpkhuong đã viết:

Trong khi chờ đợi thì ......

Mã:

Option Explicit
Sub Copy()
Dim Arr(), dArr(1 To 65536, 1 To 5)
Dim TD As Double, TE As Double, TF As Double, I, J, K


With Sheet1
    Arr = .Range("C7", .[C65000].End(xlUp)).Resize(, 16).Value
End With
For I = 1 To UBound(Arr, 1)
    If Arr(I, 7) = Cells(3, 3) Then
        K = K + 1
        dArr(K, 1) = K
        dArr(K, 2) = Arr(I, 1)
        dArr(K, 3) = Arr(I, 7)
        TD = TD + Arr(I, 7)                     '|'
        dArr(K, 4) = Arr(I, 11)
        TE = TE + Arr(I, 11)                    '|'
        dArr(K, 5) = Arr(I, 9) / 1000
        TF = TF + dArr(K, 5)                    '|'
    End If
Next I
dArr(K + 1, 2) = Sheets("Input").[a3].Value         '+'
dArr(K + 1, 3) = TD:        dArr(K + 1, 4) = TE     '+'
dArr(K + 1, 5) = TF:        dArr(K + 1, 2) = "T" & ChrW$(7893) & "ng C" & ChrW$(7897) & "ng"                      '+'
With Sheet4
    .Range("B9:F5000").ClearContents
    .Range("B9").Resize(K + 2, 5) = dArr            '|'
    .Range("B8:F" & .Range("C" & Rows.Count).End(3).Row).Borders(xlEdgeBottom).LineStyle = xlContinuous
    .Range("B8:F" & .Range("C" & Rows.Count).End(3).Row).Borders(xlEdgeTop).LineStyle = xlContinuous
    .Range("B8:F" & .Range("C" & Rows.Count).End(3).Row).Borders(xlEdgeLeft).LineStyle = xlContinuous
    .Range("B8:F" & .Range("C" & Rows.Count).End(3).Row).Borders(xlEdgeRight).LineStyle = xlContinuous
End With
End Sub

Phần dòng kẻ chưa chính xác bạn ạ. nó chỉ kẻ viền bên ngoài thôi. mình gửi file lên bạn sửa lại giúp mình với nhé
https://drive.google.com/file/d/0Bx6z3YcGDvh7YkRCaW00S0R6a1U/view?pli=1

doveandrose · 18/8/15

hong1989 đã viết:
Thầy HYen17 off rồi trong lúc chờ đợi bạn có thể viết để test thử trước được không

bạn đợi thầy í đi chứ mình cũng không rành cái này hoặc là bạn nhờ anh hpKhuong vậy

doveandrose · 18/8/15

.Range("B8:F" & .Range("C" & Rows.Count).End(3).Row).Borders(xlEdgeBottom).LineStyle = xlContinuous
.Range("B8:F" & .Range("C" & Rows.Count).End(3).Row).Borders(xlEdgeTop).LineStyle = xlContinuous
.Range("B8:F" & .Range("C" & Rows.Count).End(3).Row).Borders(xlEdgeLeft).LineStyle = xlContinuous
.Range("B8:F" & .Range("C" & Rows.Count).End(3).Row).Borders(xlEdgeRight).LineStyle = xlContinuous
.Range("B8:F" & .Range("C" & Rows.Count).End(3).Row).Borders(xlInsideVertical).LineStyle = xlContinuous
.Range("B8:F" & .Range("C" & Rows.Count).End(3).Row).Borders(xlInsideHorizontal).LineStyle = xlContinuous

lêu lêu record . -0-/.

Ngoai Thanh · 18/8/15

hong1989 đã viết:
Điều kiện là bằng ô C3 ở sheet "input". cho mình thêm chút là kẻ thêm viền kẻ khi chạy code cho những ô thỏa man điều kiện nhé

Thêm tí tẹo vào code của thầy Hải yến :

Option Explicit
Sub Copy3()
Dim Arr(), dArr(1 To 65536, 1 To 5)
Dim TD As Double, TE As Double, TF As Double, I, J, K

With Sheet1
Arr = .Range("C7", .[C65000].End(xlUp)).Resize(, 16).Value
End With
For I = 1 To UBound(Arr, 1)
If Arr(I, 7) = Cells(3, 3) Then
K = K + 1
dArr(K, 1) = K
dArr(K, 2) = Arr(I, 1)
dArr(K, 3) = Arr(I, 7)
TD = TD + Arr(I, 7) '|'
dArr(K, 4) = Arr(I, 11)
TE = TE + Arr(I, 11) '|'
dArr(K, 5) = Arr(I, 9) / 1000
TF = TF + dArr(K, 5) '|'
End If
Next I
dArr(K + 1, 2) = Sheets("Input").[a3].Value '+'
dArr(K + 1, 3) = TD: dArr(K + 1, 4) = TE '+'
dArr(K + 1, 5) = TF '+'
With Sheet4
.Range("B9:F5000").ClearContents
.Range("B9").Resize(K + 2, 5) = dArr
.Range("B9").Resize(K + 1, 5).Borders.LineStyle = 1
.Range("B9").Offset(K, 1) = "T" & ChrW$(7893) & "ng C" & ChrW$(7897) & "ng"
End With
End Sub

hong1989 · 18/8/15

hpkhuong đã viết:

Trong khi chờ đợi....

Mã:

Option Explicit
Sub Copy()
Dim Arr(), dArr(1 To 65536, 1 To 5)
Dim TD As Double, TE As Double, TF As Double, I, J, K


With Sheet1
    Arr = .Range("C7", .[C65000].End(xlUp)).Resize(, 16).Value
End With
For I = 1 To UBound(Arr, 1)
    If Arr(I, 7) = Cells(3, 3) Then
        K = K + 1
        dArr(K, 1) = K
        dArr(K, 2) = Arr(I, 1)
        dArr(K, 3) = Arr(I, 7)
        TD = TD + Arr(I, 7)                     '|'
        dArr(K, 4) = Arr(I, 11)
        TE = TE + Arr(I, 11)                    '|'
        dArr(K, 5) = Arr(I, 9) / 1000
        TF = TF + dArr(K, 5)                    '|'
    End If
Next I
dArr(K + 1, 2) = Sheets("Input").[a3].Value         '+'
dArr(K + 1, 3) = TD:        dArr(K + 1, 4) = TE     '+'
dArr(K + 1, 5) = TF:        dArr(K + 1, 2) = "T" & ChrW$(7893) & "ng C" & ChrW$(7897) & "ng"                      '+'
With Sheet4
    .Range("B9:F5000").EntireRow.Delete
    .Range("B9").Resize(K + 2, 5) = dArr            '|'
    .Range("B8:F" & .Range("C" & Rows.Count).End(3).Row).Borders(xlEdgeBottom).LineStyle = xlContinuous
    .Range("B8:F" & .Range("C" & Rows.Count).End(3).Row).Borders(xlEdgeTop).LineStyle = xlContinuous
    .Range("B8:F" & .Range("C" & Rows.Count).End(3).Row).Borders(xlEdgeLeft).LineStyle = xlContinuous
    .Range("B8:F" & .Range("C" & Rows.Count).End(3).Row).Borders(xlEdgeRight).LineStyle = xlContinuous
    .Range("B8:F" & .Range("C" & Rows.Count).End(3).Row).Borders(xlInsideVertical).LineStyle = xlContinuous
    .Range("B8:F" & .Range("C" & Rows.Count).End(3).Row).Borders(xlInsideHorizontal).LineStyle = xlContinuous
    .Range("B" & .Range("C" & Rows.Count).End(3).Row & ":F" & .Range("C" & Rows.Count).End(3).Row).Font.Bold = True
End With
End Sub

Dòng này "dArr(K + 1, 2) = Sheets("Input").[a3].Value" có nghĩa là gì ạ. Bạn có thể giải thích sơ quá về đoạn code vừa được thêm vào không. Rất cám ơn bạn

ChanhTQ@ · 18/8/15

Theo mình thì làm thế này là tiện nhất:

Ta có thể lấy dòng thứ 99, hay 999 hoặc 9999 nào đó & lập sẵn các công thức tổng & từ "Tổng cộng" vố cột [C] của dòng chọn này;

Tiến hành kể khung từ dòng chọn này trở lên trên theo í muốn;

Sau khi chạy Code của tác giả xong; ta chỉ việc tìm dòng dưới dòng cuối có số liệu & đem ẩn các dòng kể từ dòng này cho đến dòng đã chọn bên trên;

Có 2 chú í nhỏ:

(1) Dòng được chọn tùy thuộc vô dữ liệu của bạn;
(2) Vô đầu macro, ta fải cho hiện hết các dòng đã ẩn do lần chạy macro kì trước kế nó

Chúc vui vẻ & thành công!

ChanhTQ@ · 18/8/15

Hic. Cũng đã từng làm như anh Chanh, nhưng đối với dữ liệu ít dòng thì mình hoàn toàn đặt sẵn form, kẻ khung,....chạy code ẩn dòng Empty...thì lúc đó file vưa nhẹ, code vừa chạy nhanh.
(2) Nhưng nếu dữ liệu rất rất nhiều dòng..............thì việc Format sẵn form, kẻ khung,....., sau đó chạy code ẩn dòng hoặc trước khi chạy code phải bỏ ẩn dòng........thì là 1 cực hình. Vì lúc này làm dữ liệu cho file nặng, rồi unhide dòng lâu lắc..........hixxx

(1) Nếu được anh @Chanh có thể làm 1 đoạn code tối ưu cho việc ẩn/ bỏ ẩn dòng mà tốc độ cực nhanh không anh??? (với điều kiện là vài ngàn dòng trở lên...)

(1) Do không thể đọc file của chủ topic nên bạn cảm fiền đến đây: http://www.giaiphapexcel.com/forum/...-tự-chèn-thêm-hoặc-bớt-dòng-trong-excel/page2

(2) Nếu nhiều dòng đi chăng nữa thì tốc độ format các dòng không thể nhanh hơn việc ẩn cái rụp vùng cần ẩn.
Nó toàn bộ chì là 3 câu lệnh:

PHP:

1 Rows("3:9999").Hidden=false  'Hiện toàn bộ'
  ' . . . . . . . . . . . . . '  
 '  . . . . . . . . . . . . . ' 
2  Rws = [C3].End(xlDown).Row +1
3 Rows( Rws & ":9999").Hidden=true

hong1989 · 18/8/15

hpkhuong đã viết:
Úi.............đâu phải code tôi viết mà lại hỏi nhỉ???
Bạn hỏi ai code cho bạn í... (thầy Hải Yến gì ấy)..........tôi chỉ giúp bạn phần thêm chữ tổng cộng & kẻ khung/ code của thầy ấy..Còn lại thì bạn hỏi tác giả nhé!
Thân ái

P/s: mà theo tôi dòng đó thầy ấy viết bị dư.......chẳng có ý nghĩa gì cả. Hoăc là thầy ấy cố tình để dòng đó.........
Gõ vào A3 chữ tổng cộng. chạy code thì nó lấy và gán xuống cột C mong muốn cho bạn...........chắc thầy ấy làm biếng viết Unicode trong cửa sổ VBE nên vậy.........kaka

mình còn khúc mắc một chỗ cần thay đổi code 1 tí. Ban sửa giúp minh với nhé. Mình đã ghi yêu cầu trong file. Rất cám ơn bạn
https://drive.google.com/file/d/0Bx6z3YcGDvh7dmNuQzg5Qm5uU28/view?usp=sharing

hong1989 · 18/8/15

ChanhTQ@ đã viết:
Theo mình thì làm thế này là tiện nhất:

Ta có thể lấy dòng thứ 99, hay 999 hoặc 9999 nào đó & lập sẵn các công thức tổng & từ "Tổng cộng" vố cột [C] của dòng chọn này;

Tiến hành kể khung từ dòng chọn này trở lên trên theo í muốn;

Sau khi chạy Code của tác giả xong; ta chỉ việc tìm dòng dưới dòng cuối có số liệu & đem ẩn các dòng kể từ dòng này cho đến dòng đã chọn bên trên;

Có 2 chú í nhỏ:

(1) Dòng được chọn tùy thuộc vô dữ liệu của bạn;
(2) Vô đầu macro, ta fải cho hiện hết các dòng đã ẩn do lần chạy macro kì trước kế nó

Chúc vui vẻ & thành công!

anh có thể làm ví dụ trong file của em không. chứ anh nói thế em cung không biết làm thế nào **~**

Ngoai Thanh · 18/8/15

hong1989 đã viết:
mình còn khúc mắc một chỗ cần thay đổi code 1 tí. Ban sửa giúp minh với nhé. Mình đã ghi yêu cầu trong file. Rất cám ơn bạn
https://drive.google.com/file/d/0Bx6z3YcGDvh7dmNuQzg5Qm5uU28/view?usp=sharing

Bạn xem thử file xem đúng ý bạn không ? ( Làm rồi không lẽ để ...)

hong1989 · 18/8/15

Ngoai Thanh đã viết:
Bạn xem thử file xem đúng ý bạn không ? ( Làm rồi không lẽ để ...)

Bạn ơi cột tồn tính lũy kế chưa chính xác. Mình gửi file bạn xem sửa lại giúp mình nhé. Cám ơn bạn
https://drive.google.com/file/d/0Bx6z3YcGDvh7UVNoQkFVMkRfR1k/view?usp=sharing

ChanhTQ@ · 18/8/15

anh có thể làm ví dụ trong file của em không. chứ anh nói thế em cung không biết làm thế nào

File của bạn mình lại không đọc được; Chắc do máy cà tàng quá!

Bạn đến đây coi đỡ đi: http://www.giaiphapexcel.com/forum/...-đóng-khung-và-thêm-ghi-chú-cho-danh-sách-lọc

Ngoai Thanh · 18/8/15

hong1989 đã viết:
Bạn ơi cột tồn tính lũy kế chưa chính xác. Mình gửi file bạn xem sửa lại giúp mình nhé. Cám ơn bạn
https://drive.google.com/file/d/0Bx6z3YcGDvh7UVNoQkFVMkRfR1k/view?usp=sharing

Chiều mình đi vắng , giờ mới xem được , nhưng hình như bạn cũng nhầm thì phải . Mình không phải nghề nên kiểm tra mãi không tìm ra kết quả giống file bạn gửi . Bạn xem thử file xem được chưa ?

Chèn dòng tổng cộng và tính tổng (1 người xem)

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

Thành viên chính thức

/(hông là gì!

hello

Thành viên chính thức

Thành viên chính thức

hello

Thành viên chính thức

Thành viên chính thức

hello

hello

Cánh Diều xanh

Thành viên chính thức

0901452không62

0901452không62

Thành viên chính thức

Thành viên chính thức

Cánh Diều xanh

File đính kèm

Thành viên chính thức

0901452không62

Cánh Diều xanh

File đính kèm

Đếm ngược thời gian