Private Sub cmdTK_Click()
Dim sh As Worksheet
Set sh = ThisWorkbook.Sheets("B1")
With sh
.Select
.Range("D9:W33").ClearContents
.Range("I12:W12").Formula = "=SUMPRODUCT((TT_B1!$BD$6:$BD$5999="""")*(TT_B1!$N$6:$N$5999>=Data!$C$1)*(TT_B1!$N$6:$N$5999<=Data!$E$1)*(TT_B1!S6:S5999=""A"")*(TT_B1!$AJ$6:$AJ$5999=""B""))"
.Range("I13:W13").Formula = "=SUMPRODUCT((TT_B1!$BD$6:$BD$5999="""")*(TT_B1!$N$6:$N$5999>=Data!$C$1)*(TT_B1!$N$6:$N$5999<=Data!$E$1)*(TT_B1!S6:S5999=""A"")*(TT_B1!$AK$6:$AK$5999=""B""))"
.Range("I18:W18").Formula = "=SUMPRODUCT((TT_B1!$BD$6:$BD$5999="""")*(TT_B1!$N$6:$N$5999>=Data!$C$1)*(TT_B1!$N$6:$N$5999<=Data!$E$1)*(TT_B1!S6:S5999=""A"")*(TT_B1!$AN$6:$AN$5999=""B""))"
.Range("I19:W19").Formula = "=SUMPRODUCT((TT_B1!$BD$6:$BD$5999="""")*(TT_B1!$N$6:$N$5999>=Data!$C$1)*(TT_B1!$N$6:$N$5999<=Data!$E$1)*(TT_B1!S6:S5999=""A"")*(TT_B1!$AO$6:$AO$5999=""B""))"
.Range("I20:W20").Formula = "=SUMPRODUCT((TT_B1!$BD$6:$BD$5999="""")*(TT_B1!$N$6:$N$5999>=Data!$C$1)*(TT_B1!$N$6:$N$5999<=Data!$E$1)*(TT_B1!S6:S5999=""A"")*(TT_B1!$AP$6:$AP$5999=""B""))"
.Range("I23:W23").Formula = "=SUMPRODUCT((TT_B1!$BD$6:$BD$5999="""")*(TT_B1!$N$6:$N$5999>=Data!$C$1)*(TT_B1!$N$6:$N$5999<=Data!$E$1)*(TT_B1!S6:S5999=""A"")*(TT_B1!$AQ$6:$AQ$5999=""B""))"
.Range("I24:W24").Formula = "=SUMPRODUCT((TT_B1!$BD$6:$BD$5999="""")*(TT_B1!$N$6:$N$5999>=Data!$C$1)*(TT_B1!$N$6:$N$5999<=Data!$E$1)*(TT_B1!S6:S5999=""A"")*(TT_B1!$AR$6:$AR$5999=""B""))"
.Range("I25:W25").Formula = "=SUMPRODUCT((TT_B1!$BD$6:$BD$5999="""")*(TT_B1!$N$6:$N$5999>=Data!$C$1)*(TT_B1!$N$6:$N$5999<=Data!$E$1)*(TT_B1!S6:S5999=""A"")*(TT_B1!$AS$6:$AS$5999=""B""))"
.Range("I26:W26").Formula = "=SUMPRODUCT((TT_B1!$BD$6:$BD$5999="""")*(TT_B1!$N$6:$N$5999>=Data!$C$1)*(TT_B1!$N$6:$N$5999<=Data!$E$1)*(TT_B1!S6:S5999=""A"")*(TT_B1!$AT$6:$AT$5999=""B""))"
.Range("I27:W27").Formula = "=SUMPRODUCT((TT_B1!$BD$6:$BD$5999="""")*(TT_B1!$N$6:$N$5999>=Data!$C$1)*(TT_B1!$N$6:$N$5999<=Data!$E$1)*(TT_B1!S6:S5999=""A"")*(TT_B1!$AU$6:$AU$5999=""B""))"
.Range("I28:W28").Formula = "=SUMPRODUCT((TT_B1!$BD$6:$BD$5999="""")*(TT_B1!$N$6:$N$5999>=Data!$C$1)*(TT_B1!$N$6:$N$5999<=Data!$E$1)*(TT_B1!S6:S5999=""A"")*(TT_B1!$AV$6:$AV$5999=""B""))"
.Range("I31:W31").Formula = "=SUMPRODUCT((TT_B1!$BD$6:$BD$5999="""")*(TT_B1!$N$6:$N$5999>=Data!$C$1)*(TT_B1!$N$6:$N$5999<=Data!$E$1)*(TT_B1!S6:S5999=""A"")*(TT_B1!$AW$6:$AW$5999=""B""))"
.Range("D10").Formula = "=Sum(E10:M10)"
.Range("D10").Copy
.Range("D10:D14, D16:D21, D23:D29, D31:D33").PasteSpecial xlPasteFormulas
.Range("E14:W14").Formula = "=Sum(E10:E13)"
.Range("E21:W21").Formula = "=Sum(E16:E20)"
.Range("E29:W29").Formula = "=Sum(E23:E28)"
.Range("D9:W33").Value = .Range("D9:W33").Value
.Range("D9:W33").NumberFormat = "0;;;@"
.Range("U2").Select
End With
Unload uf_Nhaplieu
End Sub
Private Sub cboTenCQ1_MouseMove(ByVal Button As Integer, _
ByVal Shift As Integer, _
ByVal X As Single, _
ByVal Y As Single)
HookControlScroll cboTenCQ1
End Sub
Private Sub cboDantoc_MouseMove(ByVal Button As Integer, _
ByVal Shift As Integer, _
ByVal X As Single, _
ByVal Y As Single)
HookControlScroll cboDantoc
End Sub
Private Sub lstDS_MouseMove(ByVal Button As Integer, _
ByVal Shift As Integer, _
ByVal X As Single, _
ByVal Y As Single)
HookControlScroll lstDS
End Sub
Chưa xem file, tôi đoán lỗi là do chép dữ liệu bị xung đột name.Khí bấm vào nút Test ở Sheets("TT_B1") thì file excel tự thoát và báo lỗi như hình. Nhờ ae diễn dàn xem giúp tại sao và cách khắc phục như thế nào ?View attachment 241357View attachment 241358
Đúng vậy, mình đã xóa và bệnh đã hết. Cảm ơn bạnĐã dùng VBA thì đừng dùng nó để điền công thức. Nhìn thấy mà hoảng.
Cứ khi nào mình nói vậy là 'người ta' dựng tóc gáy... ghét mình.
PHP:Private Sub cmdTK_Click() Dim sh As Worksheet Set sh = ThisWorkbook.Sheets("B1") With sh .Select .Range("D9:W33").ClearContents .Range("I12:W12").Formula = "=SUMPRODUCT((TT_B1!$BD$6:$BD$5999="""")*(TT_B1!$N$6:$N$5999>=Data!$C$1)*(TT_B1!$N$6:$N$5999<=Data!$E$1)*(TT_B1!S6:S5999=""A"")*(TT_B1!$AJ$6:$AJ$5999=""B""))" .Range("I13:W13").Formula = "=SUMPRODUCT((TT_B1!$BD$6:$BD$5999="""")*(TT_B1!$N$6:$N$5999>=Data!$C$1)*(TT_B1!$N$6:$N$5999<=Data!$E$1)*(TT_B1!S6:S5999=""A"")*(TT_B1!$AK$6:$AK$5999=""B""))" .Range("I18:W18").Formula = "=SUMPRODUCT((TT_B1!$BD$6:$BD$5999="""")*(TT_B1!$N$6:$N$5999>=Data!$C$1)*(TT_B1!$N$6:$N$5999<=Data!$E$1)*(TT_B1!S6:S5999=""A"")*(TT_B1!$AN$6:$AN$5999=""B""))" .Range("I19:W19").Formula = "=SUMPRODUCT((TT_B1!$BD$6:$BD$5999="""")*(TT_B1!$N$6:$N$5999>=Data!$C$1)*(TT_B1!$N$6:$N$5999<=Data!$E$1)*(TT_B1!S6:S5999=""A"")*(TT_B1!$AO$6:$AO$5999=""B""))" .Range("I20:W20").Formula = "=SUMPRODUCT((TT_B1!$BD$6:$BD$5999="""")*(TT_B1!$N$6:$N$5999>=Data!$C$1)*(TT_B1!$N$6:$N$5999<=Data!$E$1)*(TT_B1!S6:S5999=""A"")*(TT_B1!$AP$6:$AP$5999=""B""))" .Range("I23:W23").Formula = "=SUMPRODUCT((TT_B1!$BD$6:$BD$5999="""")*(TT_B1!$N$6:$N$5999>=Data!$C$1)*(TT_B1!$N$6:$N$5999<=Data!$E$1)*(TT_B1!S6:S5999=""A"")*(TT_B1!$AQ$6:$AQ$5999=""B""))" .Range("I24:W24").Formula = "=SUMPRODUCT((TT_B1!$BD$6:$BD$5999="""")*(TT_B1!$N$6:$N$5999>=Data!$C$1)*(TT_B1!$N$6:$N$5999<=Data!$E$1)*(TT_B1!S6:S5999=""A"")*(TT_B1!$AR$6:$AR$5999=""B""))" .Range("I25:W25").Formula = "=SUMPRODUCT((TT_B1!$BD$6:$BD$5999="""")*(TT_B1!$N$6:$N$5999>=Data!$C$1)*(TT_B1!$N$6:$N$5999<=Data!$E$1)*(TT_B1!S6:S5999=""A"")*(TT_B1!$AS$6:$AS$5999=""B""))" .Range("I26:W26").Formula = "=SUMPRODUCT((TT_B1!$BD$6:$BD$5999="""")*(TT_B1!$N$6:$N$5999>=Data!$C$1)*(TT_B1!$N$6:$N$5999<=Data!$E$1)*(TT_B1!S6:S5999=""A"")*(TT_B1!$AT$6:$AT$5999=""B""))" .Range("I27:W27").Formula = "=SUMPRODUCT((TT_B1!$BD$6:$BD$5999="""")*(TT_B1!$N$6:$N$5999>=Data!$C$1)*(TT_B1!$N$6:$N$5999<=Data!$E$1)*(TT_B1!S6:S5999=""A"")*(TT_B1!$AU$6:$AU$5999=""B""))" .Range("I28:W28").Formula = "=SUMPRODUCT((TT_B1!$BD$6:$BD$5999="""")*(TT_B1!$N$6:$N$5999>=Data!$C$1)*(TT_B1!$N$6:$N$5999<=Data!$E$1)*(TT_B1!S6:S5999=""A"")*(TT_B1!$AV$6:$AV$5999=""B""))" .Range("I31:W31").Formula = "=SUMPRODUCT((TT_B1!$BD$6:$BD$5999="""")*(TT_B1!$N$6:$N$5999>=Data!$C$1)*(TT_B1!$N$6:$N$5999<=Data!$E$1)*(TT_B1!S6:S5999=""A"")*(TT_B1!$AW$6:$AW$5999=""B""))" .Range("D10").Formula = "=Sum(E10:M10)" .Range("D10").Copy .Range("D10:D14, D16:D21, D23:D29, D31:D33").PasteSpecial xlPasteFormulas .Range("E14:W14").Formula = "=Sum(E10:E13)" .Range("E21:W21").Formula = "=Sum(E16:E20)" .Range("E29:W29").Formula = "=Sum(E23:E28)" .Range("D9:W33").Value = .Range("D9:W33").Value .Range("D9:W33").NumberFormat = "0;;;@" .Range("U2").Select End With Unload uf_Nhaplieu End Sub
Xóa đoạn này đi thì Excel hết đột tử đột xuất.
PHP:Private Sub cboTenCQ1_MouseMove(ByVal Button As Integer, _ ByVal Shift As Integer, _ ByVal X As Single, _ ByVal Y As Single) HookControlScroll cboTenCQ1 End Sub Private Sub cboDantoc_MouseMove(ByVal Button As Integer, _ ByVal Shift As Integer, _ ByVal X As Single, _ ByVal Y As Single) HookControlScroll cboDantoc End Sub Private Sub lstDS_MouseMove(ByVal Button As Integer, _ ByVal Shift As Integer, _ ByVal X As Single, _ ByVal Y As Single) HookControlScroll lstDS End Sub
Vẫn bị lỗi tự tắt bạn à. Xem giúp mình được với nhéXóa đoạn này đi thì Excel hết đột tử đột xuất.
PHP:Private Sub cboTenCQ1_MouseMove(ByVal Button As Integer, _ ByVal Shift As Integer, _ ByVal X As Single, _ ByVal Y As Single) HookControlScroll cboTenCQ1 End Sub Private Sub cboDantoc_MouseMove(ByVal Button As Integer, _ ByVal Shift As Integer, _ ByVal X As Single, _ ByVal Y As Single) HookControlScroll cboDantoc End Sub Private Sub lstDS_MouseMove(ByVal Button As Integer, _ ByVal Shift As Integer, _ ByVal X As Single, _ ByVal Y As Single) HookControlScroll lstDS End Sub
Bác đã xóa các đoạn Hook chưa vì HookControlScroll Bị saiVẫn bị lỗi tự tắt bạn à. Xem giúp mình được với nhé
Sub HookControlScroll(ByVal ctl As Object)
' Dim lngAppInst As Long
' Dim hwndUnderCursor As Long
' Dim tPT As PointAPI
' GetCursorPos tPT
' hwndUnderCursor = WindowFromPoint(tPT.X, tPT.Y)
' If mControlHwnd <> hwndUnderCursor Then
' UnhookControlScroll
' Set mCtl = ctl
' mControlHwnd = hwndUnderCursor
' lngAppInst = GetWindowLong(mControlHwnd, GWL_HINSTANCE)
' If Not mbHook Then
' mLngMouseHook = _
' SetWindowsHookEx(WH_MOUSE_LL, _
' AddressOf MouseProc, _
' lngAppInst, 0)
' mbHook = mLngMouseHook <> 0
' End If
' End If
End Sub
Cảm ơn bạn, mình đã bỏ hết rồi mà nó vẫn báo lỗiBác đã xóa các đoạn Hook chưa vì HookControlScroll Bị sai
Cái này do là chỉ biết copy vào sử dụng chứ chưa chỉnh sửa cho phù hợp ứng dụng.
Phải biết Khởi tạo và đóng Hook khi nào cần.
Nên bỏ Hook, Comment thủ tục HookControlScroll lại. Chờ cho đến khi biết cách chế ngự quá trình bắt sự kiện chuột.
--------------------------------------
JavaScript:Sub HookControlScroll(ByVal ctl As Object) ' Dim lngAppInst As Long ' Dim hwndUnderCursor As Long ' Dim tPT As PointAPI ' GetCursorPos tPT ' hwndUnderCursor = WindowFromPoint(tPT.X, tPT.Y) ' If mControlHwnd <> hwndUnderCursor Then ' UnhookControlScroll ' Set mCtl = ctl ' mControlHwnd = hwndUnderCursor ' lngAppInst = GetWindowLong(mControlHwnd, GWL_HINSTANCE) ' If Not mbHook Then ' mLngMouseHook = _ ' SetWindowsHookEx(WH_MOUSE_LL, _ ' AddressOf MouseProc, _ ' lngAppInst, 0) ' mbHook = mLngMouseHook <> 0 ' End If ' End If End Sub
Cảm ơn bạn, máy mình windows 8.1 32 bit, Office 2010 32 bit. Bạn Maica8008 đoán là lỗi sung Name. Mình đã kiểm tra lại nhưng vẫn không phát hiện ra là bị sao.Sao máy tôi mở lên, bấm test, thao tác lung tung trong Userform mà không thấy báo lỗi gì nhỉ.
(Windows 7 32bit, Office 2013 32bit)