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
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
Bạn cần đăng nhập để thấy link
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ácFile 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!
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
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ắmVâ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