Bị gộp khi xuất dữ liệu.

hathanh349 · 27/8/23

Nhơ các bác xem giúp lỗi gì mà khi e xuất dữ liệu ra thì bị gộp dữ liệu từ dòng 67 đến 105. khi mà dữ liệu gốc ở sheet1 là từ dòng 82 đến 147. Càm ơn các bác nhiều ah. code em từ mày mò sao chép. các bác thông cảm

SA_DQ · 28/8/23

Nhận xét sơ bộ & có thể làm bạn phật ý:
→ Nếu đúng trình độ VBA của bạn là 'sao chép' thì chưa nên xài câu lệnh:

Mã:

 On Error Resume Next

Cứ để nó thể hiện (những) chỗ sai sót (nếu có) để còn tìm cách khắc phục
Còn 1 cách nữa là

PHP:

 On Error Goto LoiCT
' . . . .  Các Dòng Lênh  '
Err_:    Exit Sub
LoiCT: 
 If Err>0 Then
   MsgBox Err,, Error()
   Resume Err_
 End If
End Sub

→ Bạn có 3 trang tính mà trang nào cũng có trộn ô theo cột;
Tuy nó diêm dúa hơn đó, như khó cho bạn khi viết VBA
Theo mình thì phải có chí ít 1 trang (thu thập dữ liệu) không ô nào bị trộn như vậy

→ Các câu lệnh trong 2 nhóm

Mã:

    Application.ScreenUpdating = False
    Application.EnableEvents = False
    Application.DisplayAlerts = False
    Application.Calculation = xlManual

&

Mã:

Application.ScreenUpdating = True
    Application.EnableEvents = True
    Application.DisplayAlerts = True
    Application.Calculation = xlAutomatic

Nên tách riêng thành 1 macro con nhận tham biến True & False
Như

PHP:

 Sub ManHinh (CN As  Boolean)
  Application.ScreenUpdating = CN
    Application.EnableEvents = CN
    Application.DisplayAlerts = CN
If CN Then
   '. . . .'
End If
End Sub

Điều này tuy có vẻ dài dòng, nhưng không làm 'loãng' chương trình chính của bạn'

hathanh349 · 29/8/23

SA_DQ đã viết:
Nhận xét sơ bộ & có thể làm bạn phật ý:
→ Nếu đúng trình độ VBA của bạn là 'sao chép' thì chưa nên xài câu lệnh:

Mã:

On Error Resume Next

Cứ để nó thể hiện (những) chỗ sai sót (nếu có) để còn tìm cách khắc phục
Còn 1 cách nữa là

PHP:

On Error Goto LoiCT ' . . . . Các Dòng Lênh ' Err_: Exit Sub LoiCT: If Err>0 Then MsgBox Err,, Error() Resume Err_ End If End Sub

→ Bạn có 3 trang tính mà trang nào cũng có trộn ô theo cột;
Tuy nó diêm dúa hơn đó, như khó cho bạn khi viết VBA
Theo mình thì phải có chí ít 1 trang (thu thập dữ liệu) không ô nào bị trộn như vậy

→ Các câu lệnh trong 2 nhóm

Mã:

Application.ScreenUpdating = False Application.EnableEvents = False Application.DisplayAlerts = False Application.Calculation = xlManual

&

Mã:

Application.ScreenUpdating = True Application.EnableEvents = True Application.DisplayAlerts = True Application.Calculation = xlAutomatic

Nên tách riêng thành 1 macro con nhận tham biến True & False
Như

PHP:

Sub ManHinh (CN As Boolean) Application.ScreenUpdating = CN Application.EnableEvents = CN Application.DisplayAlerts = CN If CN Then '. . . .' End If End Sub

Điều này tuy có vẻ dài dòng, nhưng không làm 'loãng' chương trình chính của bạn'

Vâng. Cảm ơn bạn đã nhận xét và đúng luân. Mình chỉ xem và cop vào. Nên nhiều lúc chưa logic
Bạn có thể chỉ sửa giúp mình phần lỗi khi chạy chương trình không ah. Vì khi xuất ra đang bị lỗi

SA_DQ · 29/8/23

Mình chỉ có khả năng giúp bạn các bước tiến hành phát hiện lỗi thôi nha:
B1: Bạn vô hiệu hóa dòng lệnh On Error Resume next
& chạy Code xem có lỗi gì không;
Trường hợp không bị báo lỗi mà kết quả sai thì mình khó giúp tiếp;
Bằng ngược lại ta sang B2:
B2: Bạn có hơn 13 dòng lệnh bắt đầu bằng With. . .
Bạn đánh số các dòng lệnh này & chú í là số không đính liền với W trong With à nha;
Sau đó sửa lại các câu lệnh của bài trên của mình như sau:

PHP:

 On Error Goto LoiCT                    'Thay Cho Câu Lệnh Đã Xóa đi   '
' . . . .  Các Dòng Lênh của bạn  '
Err_:    Exit Sub
LoiCT:
 If Err>0 Then
   MsgBox Erl(),, Error()
   Resume Err_
 End If
End Sub

Hàm Erl() sẽ báo ta biết đang lỗi đầu tiên đang ở dòng lệnh nào (trong 'khổ ' With nào)

hathanh349 · 29/8/23

SA_DQ đã viết:
Mình chỉ có khả năng giúp bạn các bước tiến hành phát hiện lỗi thôi nha:
B1: Bạn vô hiệu hóa dòng lệnh On Error Resume next
& chạy Code xem có lỗi gì không;
Trường hợp không bị báo lỗi mà kết quả sai thì mình khó giúp tiếp;
Bằng ngược lại ta sang B2:
B2: Bạn có hơn 13 dòng lệnh bắt đầu bằng With. . .
Bạn đánh số các dòng lệnh này & chú í là số không đính liền với W trong With à nha;
Sau đó sửa lại các câu lệnh của bài trên của mình như sau:

PHP:

On Error Goto LoiCT 'Thay Cho Câu Lệnh Đã Xóa đi ' ' . . . . Các Dòng Lênh của bạn ' Err_: Exit Sub LoiCT: If Err>0 Then MsgBox Erl(),, Error() Resume Err_ End If End Sub

Hàm Erl() sẽ báo ta biết đang lỗi đầu tiên đang ở dòng lệnh nào (trong 'khổ ' With nào)

Cảm ơn bác đã phản hồi. Để e cố gắng tếp ah

SA_DQ · 30/8/23

Dòng lệnh mang số 41 đang bị lỗi 1004:

PHP:

'. . . . . .             '
        With ActiveSheet
            .Range("B9:I300").Delete shift:=xlUp
            .Range("B9").Resize(k, 8).Value = Res
3            Lr = .Range("E" & Rows.Count).End(xlUp).Row
            For i = 9 To Lr
                If .Cells(i, 2) = .Cells(i + 1, 2) Then
                    a = i - t:              t = t + 1
4                Else
41                    .Range("B" & a & ":B" & a + t).Merge:   .Range("A" & a & ":A" & a + t).Merge
42                    .Range("C" & a & ":C" & a + t).Merge:   .Range("D" & a & ":D" & a + t).Merge
                    .Range("I" & a & ":I" & a + t).Merge:   .Range("J" & a & ":J" & a + t).Merge
                    .Range("H" & i) = .Range("G" & i):      .Range("H" & a & ":H" & a + t).Merge
                    .Range("H" & a) = Application.Sum(.Range("G" & a & ":G" & a + t))
                        t = 0: a = 0
                End If
            Next i
         End With
    ' Danh So TT

hathanh349 · 30/8/23

SA_DQ đã viết:

Dòng lệnh mang số 41 đang bị lỗi 1004:

PHP:

'. . . . . .             '
        With ActiveSheet
            .Range("B9:I300").Delete shift:=xlUp
            .Range("B9").Resize(k, 8).Value = Res
3            Lr = .Range("E" & Rows.Count).End(xlUp).Row
            For i = 9 To Lr
                If .Cells(i, 2) = .Cells(i + 1, 2) Then
                    a = i - t:              t = t + 1
4                Else
41                    .Range("B" & a & ":B" & a + t).Merge:   .Range("A" & a & ":A" & a + t).Merge
42                    .Range("C" & a & ":C" & a + t).Merge:   .Range("D" & a & ":D" & a + t).Merge
                    .Range("I" & a & ":I" & a + t).Merge:   .Range("J" & a & ":J" & a + t).Merge
                    .Range("H" & i) = .Range("G" & i):      .Range("H" & a & ":H" & a + t).Merge
                    .Range("H" & a) = Application.Sum(.Range("G" & a & ":G" & a + t))
                        t = 0: a = 0
                End If
            Next i
         End With
    ' Danh So TT

dòng 41 lỗi là khi gộp ô. nhưng khi e chạy code bỏ lệnh On Error Resume Next, khi ra dữ liệu nó đã lấy sai rồi. Ở tên Nông văn Quý này là chỉ đế dòng 74 thôi. nhưng ở đây lấy đến tận dòng 105. nhờ bác xem giúp

SA_DQ · 31/8/23

(1) Vấn đề là ngoài 'Nông Văn Quí' có còn giảng viên nào sai nữa hay không?
(2) & vì là gộp ô đang gây sai; Cho nên bạn thử vô hiệu hóa các dòng lệnh gộp ô có trước dòng lệnh 5 xem kết quả ra sao?
Vô hiệu hóa bỡi dấu "'" đầu dòng lệnh nha, mình không khuyên xóa hẵn các dòng lệnh này!
(3) Xem kỹ lại bảng dữ liệu, nhất là các dòng có tên chàng 'Quý' này có gì khác thường không

& trên hết là mình chỉ giúp bạn cách tìm ra lỗi thôi, & sẽ không tìm ra lỗi chương trình của bạn chưa đúng ở đâu.

SA_DQ · 31/8/23

Ở 1 khía cạnh khác, bạn không nên xài họ & tên giảng viên (GV) mà nên xài mã GV như cách sau:

STT	Ho & Ten	Mã GV
1	Cao Thị Huệ	CTH00
2	Cù Thị Thu	CTT00
3	Chảo Thị Vân	CTV00
4	Đoàn Thị Kiều Trang	FKT00
5	Đinh Thanh Hải	FTH00
6	Đặng Thị Ngoãn	FTN00
7	Đèo Văn An	FVA00
8	Hà Lương Thanh	HLT00
9	Hù Văn Tìm	HVT00
10	Lò Thị Xoán	LTX00
11	Lý Văn Mằn	LVM00
12	Lê Việt Phương	LVP00
13	Mai Thị Ngọc Ánh	MNA00
14	Nguyễn Đức Long	NFL00
15	Nguyễn Quý Tùng	NQT00
16	Nguyễn Thế Giang	NTG00
17	Nguyễn Thị Thuận	NTT00
18	Nông Văn Quý	NVQ00
19	Nguyễn Văn Thịnh	NVT00
20	Phạm Như Sinh	PNS00
21	Phạm Thị Liên	PTL00
22	Phạm Văn Hiệu	PVH00
23	Trần Thị Hương Xen	THX00
24	Trần Thị Mỹ Hạnh	TMH00
25	Trịnh Thị Thanh Huyền	TTH00
26	Thùng Thị Nguyệt	TTN00
27	Vũ Ngọc Hà	VNH00
28	Vương Văn Hoàn	VVH00
29	Vũ Văn Sơn	VVS00

Cách này rất tiện lợi trong xây dựng & vận hành 1 CSDL

HieuCD · 31/8/23

hathanh349 đã viết:
Nhơ các bác xem giúp lỗi gì mà khi e xuất dữ liệu ra thì bị gộp dữ liệu từ dòng 67 đến 105. khi mà dữ liệu gốc ở sheet1 là từ dòng 82 đến 147. Càm ơn các bác nhiều ah. code em từ mày mò sao chép. các bác thông cảm

Dúng 1 sheet lưu mẩu báo cáo, code copy sheet nầy cho từng tuần

Mã:

Option Explicit
Sub XYZ()
  Dim sh As Worksheet, arr(), aTuan(), res()
  Dim sRow&, i&, j&, k&, r&, t&, stt&, STuan, tuan$

  arr = Sheet1.Range("B9:X" & Sheet1.Range("F" & Rows.Count).End(xlUp).Row).Value
  aTuan = Sheet1.Range("B7:X7").Value

  STuan = Application.InputBox(Prompt:="Hay nhap so", Type:=1)
  For t = 6 To UBound(aTuan, 2)
    If STuan = aTuan(1, t) Then Exit For
  Next t
  If t > UBound(aTuan, 2) Then MsgBox ("Không tim thay tuan: " & STuan): Exit Sub
 
  Call TangToc(False)
  tuan = "Tuan" & aTuan(1, t)
  For j = 1 To Sheets.Count
    If Sheets(j).Name = tuan Then Exit For
  Next j
  If j > Sheets.Count Then
    Sheets("MauBC").Copy After:=Sheets(Sheets.Count)
    ActiveSheet.Name = tuan
  End If
  Set sh = Sheets(tuan)
  i = sh.Range("F" & Rows.Count).End(xlUp).Row
  If i > 9 Then sh.Range("A10:J" & i + 3).Clear

  sRow = UBound(arr)
  ReDim res(1 To sRow, 1 To 9)
  For i = 1 To sRow
    If arr(i, 1) <> Empty Then
      stt = stt + 1
      r = k + 1
      res(k + 1, 1) = stt
      res(k + 1, 2) = arr(i, 1)
      res(k + 1, 3) = arr(i, 2)
      res(k + 1, 4) = arr(i, 3)
    End If
    If arr(i, t) <> Empty Then
      If arr(i, 5) <> Empty Then
        k = k + 1
        res(k, 5) = arr(i, 4): res(k, 6) = arr(i, 5)
        res(k, 7) = arr(i, t)
        res(r, 8) = res(r, 8) + res(k, 7)
        res(r, 9) = res(r, 9) + 1
      End If
    End If
  Next i
 
  sh.Range("A9").Resize(k, 8) = res
  sh.Range("A9:J9").Copy
  sh.Range("A9").Resize(k, 10).PasteSpecial Paste:=xlPasteFormats
  Application.CutCopyMode = False
  For i = 1 To k
    If res(i, 9) > 1 Then
      For j = 1 To 10
        If j < 5 Or j > 7 Then sh.Cells(i + 8, j).Resize(res(i, 9)).Merge
      Next j
    End If
  Next i
  Call TangToc(True)
End Sub

Private Sub TangToc(ByVal bCham As Boolean)
  Application.ScreenUpdating = bCham
  Application.EnableEvents = bCham
  Application.DisplayAlerts = bCham
  If bCham Then
    Application.Calculation = xlCalculationAutomatic
  Else
    Application.Calculation = xlManual
  End If
End Sub

SA_DQ · 31/8/23

HieuCD đã viết:
Dúng 1 sheet lưu mẩu báo cáo, code copy sheet nầy cho từng tuần
. . . .

Mình dự định để giành mà chừ chàng HieuCD phá bể nồi niêu hết rồi!

HieuCD · 31/8/23

SA_DQ đã viết:
Mình dự định để giành mà chừ chàng HieuCD phá bể nồi niêu hết rồi!

Xin lỗi nhé, thấy rê qua rê lại lâu quá chưa chịu cạn ly, mình không chờ được nên nhảy vào góp vui /-*+/

SA_DQ · 31/8/23

Trái đi mua tất nhiên là ngon; Nhưng không tuyệt dịu bằng thưởng thức quả mình trồng được!

hathanh349 · 31/8/23

Rất cảm ơn các bác đã có những chỉ dạy.

SA_DQ · 31/8/23

Vẫn thấy biểu mẫu có điểm gợn (theo thiển ý cá nhân) nên phát biểu để chủ bài đăng xem xét:
(1) Trong trang tính 'PC có 2 cột dữ liệu nên tách ra bỏ qua 1 bên; đó là 'TĐ'(trình độ?) & 'CM' (chuyên môn?)
(2) Những dữ liệu này nên ở trang 'DSGV' (Danh sách giảng viên); Trong trang này ta có thể thêm thông tin về các GV,. . . .
& như đã đề xuất nhất thiết phải có mã GV cho mỗi người & là duy nhất;

Bị gộp khi xuất dữ liệu.

hathanh349

Thành viên mới

File đính kèm

SA_DQ

/(hông là gì!

hathanh349

Thành viên mới

SA_DQ

/(hông là gì!

hathanh349

Thành viên mới

SA_DQ

/(hông là gì!

hathanh349

Thành viên mới

SA_DQ

/(hông là gì!

SA_DQ

/(hông là gì!

HieuCD

Chuyên gia GPE

File đính kèm

SA_DQ

/(hông là gì!

HieuCD

Chuyên gia GPE

SA_DQ

/(hông là gì!

hathanh349

Thành viên mới

SA_DQ

/(hông là gì!

Bài viết mới nhất

Thành viên có số lượng bài viết cao nhất tháng

Thành viên có điểm tương tác cao nhất tháng