Cộng giá trị theo cột trong ListView

ThienTan

Yêu THVBA
K/g các anh chị
Nhờ ac giúp code tính tổng 1 cột trên ListView
Cảm ơn các ac
 

phuongnamhp92

Yêu THVBA
Listview không hỗ trợ Excel 64bit => nên chuyển sang dùng control khác.
Dưới đây là đoạn code để lặp qua các dòng trong 1 listview:
Lấy dữ liệu các hàng trong listview:
Dim st As Double
For i = 1 To ListView1.ListItems.Count
    st = ListView1.ListItems(i) + st    'nếu cột cần tính là cột đầu tiên'
    st = ListView1.ListItems(i).SubItems(2) + st     'nếu cột cần tính là cột khác'
Next
 

ThienTan

Yêu THVBA
Cảm ơn Bác, tôi cũng là người Hải Phòng, rất vui khi gặp đồng hương. Làm phiền bác và các ac giúp thêm:
- Xử lý Font chữ tiếng Việt trên ListViiew thì tôi làm được rồi, nhưng khi đưa vào Sheet thì lại bị lỗi Font.
Tôi gửi file lên mong các ac hỗ trợ.
Cảm ơn rất nhiều
 

phuongnamhp92

Yêu THVBA
File Bác gửi kia em không có quyền truy cập, không tải về được
Không rõ bác xử lý tiếng Việt thế nào, nếu sử dụng phương pháp convert font unicode => ABC... thì khi export từ listview ra cũng phải làm thao tác chuyển font trước khi đổ xuống sheet.
Bác kiểm tra lại xem!
 

ThienTan

Yêu THVBA
File Bác gửi kia em không có quyền truy cập, không tải về được
Không rõ bác xử lý tiếng Việt thế nào, nếu sử dụng phương pháp convert font unicode => ABC... thì khi export từ listview ra cũng phải làm thao tác chuyển font trước khi đổ xuống sheet.
Bác kiểm tra lại xem!
Trang này ko cho gửi file trực tiếp. E đã chấp thuận quyền truy cập file rồi mà bác
 

phuongnamhp92

Yêu THVBA
Vâng sau khi e xem qua code files của bác thì có nhiều lỗi, cụ thể là trong sub Cmd_Nhap_Click()
1. Khai báo biến mảng và nhập dữ liệu vào mảng sai
2. Vòng lặp for next nhưng thiếu next, With-end with thì thiếu end with
3. Đổ dữ liệu xuống sheet nhưng không chỉ định sheet nào( chỉ có .cells() => lỗi)
Ngoài ra thì code chuyển font có vẻ cũng chưa chính xác lắm
Code gốc:
Private Sub Cmd_Nhap_Click()
Dim row As Long, col As Integer, EndRow As Long, n As Long
Dim LvArr, iR As Long, iLv As Long, jLv As Long
    iR = LV_Data.ListItems.Count
        If Sheet1.Range("A2") = "" Then EndRow = 1
        If Sheet1.Range("A2") <> "" Then EndRow = Sheet1.Range("A9999").End(xlUp).row
        n = EndRow
    '
        With LV_Data
        For row = 2 To .ListItems.Count + 1
            n = n + 1
            For col = 1 To .ColumnHeaders.Count
                For iLv = 1 To iR
                    LvArr(iLv + 1, 1) = .ListItems(iLv)
                    With .ListItems(iLv)
                        For jLv = 1 To 5
                            Select Case jLv
                                Case 0, 1, 4, 5: LvArr(iLv + 1, jLv + 1) = .SubItems(jLv)
                                Case Else: LvArr(iLv + 1, jLv + 1) = FontConverter(.SubItems(jLv), 3, 1)
                                'With Sheet1
                                If col = 1 Then
                                    Sheet1.Cells(n, "A").Value = LvArr.ListItems(row - 1).text                          'STT
                    '.Cells(n, "A").Value = LV_Data.ListItems(row - 1).text                          'STT
                                Else
                                    Sheet1.Cells(n, "B").Value = LvArr.ListItems(row - 1).SubItems(2)    'Tên
                                    Sheet1.Cells(n, "C").Value = LvArr.ListItems(row - 1).SubItems(3)    'Ðia chi
                                    .Cells(n, "D").Value = LvArr.ListItems(row - 1).SubItems(4)               'Muc luong
                                    .Cells(n, "E").Value = LvArr.ListItems(row - 1).SubItems(5)               'Thanh toán
                   
                    '.Cells(n, "B").Value = Font_ToLv(LV_Data.ListItems(row - 1).SubItems(2))    'Tên
                    '.Cells(n, "C").Value = Font_ToLv(LV_Data.ListItems(row - 1).SubItems(3))    'Ðia chi
                    '.Cells(n, "D").Value = LV_Data.ListItems(row - 1).SubItems(4)               'Muc luong
                    '.Cells(n, "E").Value = LV_Data.ListItems(row - 1).SubItems(5)               'Thanh toán
                                End If
    'End With
                            End Select
                        Next
            Next col
        Next row
                    End With
    LV_Data.ListItems.Clear
End Sub
Code tham khảo:
Private Sub Cmd_Nhap_Click()
      Dim row As Long, col As Integer, EndRow As Long, n As Long
      Dim iR As Long, i As Long, j As Long
      iR = LV_Data.ListItems.Count
      If iR > 0 Then
            With LV_Data
                  ReDim LvArr(1 To .ListItems.Count, 1 To .ColumnHeaders.Count)
                 
                  For i = 1 To iR    'bổ xung code xử lý tiếng Việt'
                        LvArr(i, 1) = .ListItems(i)  
                        For j = 1 To .ColumnHeaders.Count - 1
                              LvArr(i, j + 1) = .ListItems(i).ListSubItems(j)   
                        Next
                  Next
                  With Sheet1
                        .Range("A" & .Range("A100000").End(xlUp).row + 1).Resize(iR, UBound(LvArr, 2)).Value = LvArr
                  End With
            End With
      End If
      LV_Data.ListItems.Clear
End Sub
 

ThienTan

Yêu THVBA
Vâng sau khi e xem qua code files của bác thì có nhiều lỗi, cụ thể là trong sub Cmd_Nhap_Click()
1. Khai báo biến mảng và nhập dữ liệu vào mảng sai
2. Vòng lặp for next nhưng thiếu next, With-end with thì thiếu end with
3. Đổ dữ liệu xuống sheet nhưng không chỉ định sheet nào( chỉ có .cells() => lỗi)
Ngoài ra thì code chuyển font có vẻ cũng chưa chính xác lắm
Code gốc:
Private Sub Cmd_Nhap_Click()
Dim row As Long, col As Integer, EndRow As Long, n As Long
Dim LvArr, iR As Long, iLv As Long, jLv As Long
    iR = LV_Data.ListItems.Count
        If Sheet1.Range("A2") = "" Then EndRow = 1
        If Sheet1.Range("A2") <> "" Then EndRow = Sheet1.Range("A9999").End(xlUp).row
        n = EndRow
    '
        With LV_Data
        For row = 2 To .ListItems.Count + 1
            n = n + 1
            For col = 1 To .ColumnHeaders.Count
                For iLv = 1 To iR
                    LvArr(iLv + 1, 1) = .ListItems(iLv)
                    With .ListItems(iLv)
                        For jLv = 1 To 5
                            Select Case jLv
                                Case 0, 1, 4, 5: LvArr(iLv + 1, jLv + 1) = .SubItems(jLv)
                                Case Else: LvArr(iLv + 1, jLv + 1) = FontConverter(.SubItems(jLv), 3, 1)
                                'With Sheet1
                                If col = 1 Then
                                    Sheet1.Cells(n, "A").Value = LvArr.ListItems(row - 1).text                          'STT
                    '.Cells(n, "A").Value = LV_Data.ListItems(row - 1).text                          'STT
                                Else
                                    Sheet1.Cells(n, "B").Value = LvArr.ListItems(row - 1).SubItems(2)    'Tên
                                    Sheet1.Cells(n, "C").Value = LvArr.ListItems(row - 1).SubItems(3)    'Ðia chi
                                    .Cells(n, "D").Value = LvArr.ListItems(row - 1).SubItems(4)               'Muc luong
                                    .Cells(n, "E").Value = LvArr.ListItems(row - 1).SubItems(5)               'Thanh toán
                  
                    '.Cells(n, "B").Value = Font_ToLv(LV_Data.ListItems(row - 1).SubItems(2))    'Tên
                    '.Cells(n, "C").Value = Font_ToLv(LV_Data.ListItems(row - 1).SubItems(3))    'Ðia chi
                    '.Cells(n, "D").Value = LV_Data.ListItems(row - 1).SubItems(4)               'Muc luong
                    '.Cells(n, "E").Value = LV_Data.ListItems(row - 1).SubItems(5)               'Thanh toán
                                End If
    'End With
                            End Select
                        Next
            Next col
        Next row
                    End With
    LV_Data.ListItems.Clear
End Sub
Code tham khảo:
Private Sub Cmd_Nhap_Click()
      Dim row As Long, col As Integer, EndRow As Long, n As Long
      Dim iR As Long, i As Long, j As Long
      iR = LV_Data.ListItems.Count
      If iR > 0 Then
            With LV_Data
                  ReDim LvArr(1 To .ListItems.Count, 1 To .ColumnHeaders.Count)
                
                  For i = 1 To iR    'bổ xung code xử lý tiếng Việt'
                        LvArr(i, 1) = .ListItems(i) 
                        For j = 1 To .ColumnHeaders.Count - 1
                              LvArr(i, j + 1) = .ListItems(i).ListSubItems(j)  
                        Next
                  Next
                  With Sheet1
                        .Range("A" & .Range("A100000").End(xlUp).row + 1).Resize(iR, UBound(LvArr, 2)).Value = LvArr
                  End With
            End With
      End If
      LV_Data.ListItems.Clear
End Sub
Cảm ơn bác nhiều lắm
 
Top