Sữa lỗi: Runtime error '424' (1 người xem)

Liên hệ QC

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

spacemanforever

Thành viên hoạt động
Tham gia
8/10/08
Bài viết
113
Được thích
71
Dear GPE!
Nội dung:
-em có 4 checkbox (checkbox1 - Date, Checkbox2 - A No., Checkbox3 - B No., Checkbox4 - C No.)
-Mỗi checkbox gồm 2 ô điều kiện (From .., to ...) điều kiên From <= To.
Lỗi phát sinh:
Khi tiến hàng cho chạy code:
PHP:
Sub test()
Dim i, kq
d1 = CDbl([H3].Value)
d2 = CDbl([J3].Value)
i = 0
If CheckBox1.Value = True Then
 If d1 > d2 Then
              kq = kq & "Date error" & Chr(10)
              i = i + 1
 End If
End If
If CheckBox2.Value = True Then
 If [H5].Value > [J5].Value Then
                                 kq = kq & "A No. error" & Chr(10)
                                 i = i + 1
 End If
End If
If CheckBox3.Value = True Then
 If [H7].Value > [J7].Value Then
                                 kq = kq & "B No. error" & Chr(10)
                                 i = i + 1
 End If
End If
If CheckBox4.Value = True Then
 If [H9].Value > [J9].Value Then
                                 kq = kq & "C No. error" & Chr(10)
                                 i = i + 1
 End If
End If
'Report
If i <> 0 Then MsgBox kq & vbNewLine & " Please check it again"
End Sub

Thì bị báo lỗi RUNTIME ERROR '424': OBJECT REQUIRED.

Anh chị hỗ trợ giúp em nhé.
Thanks--=0
 

File đính kèm

Dear GPE!
Nội dung:
-em có 4 checkbox (checkbox1 - Date, Checkbox2 - A No., Checkbox3 - B No., Checkbox4 - C No.)
-Mỗi checkbox gồm 2 ô điều kiện (From .., to ...) điều kiên From <= To.
Lỗi phát sinh:
Khi tiến hàng cho chạy code:
PHP:
Sub test()
Dim i, kq
d1 = CDbl([H3].Value)
d2 = CDbl([J3].Value)
i = 0
If CheckBox1.Value = True Then
 If d1 > d2 Then
              kq = kq & "Date error" & Chr(10)
              i = i + 1
 End If
End If
If CheckBox2.Value = True Then
 If [H5].Value > [J5].Value Then
                                 kq = kq & "A No. error" & Chr(10)
                                 i = i + 1
 End If
End If
If CheckBox3.Value = True Then
 If [H7].Value > [J7].Value Then
                                 kq = kq & "B No. error" & Chr(10)
                                 i = i + 1
 End If
End If
If CheckBox4.Value = True Then
 If [H9].Value > [J9].Value Then
                                 kq = kq & "C No. error" & Chr(10)
                                 i = i + 1
 End If
End If
'Report
If i <> 0 Then MsgBox kq & vbNewLine & " Please check it again"
End Sub

Thì bị báo lỗi RUNTIME ERROR '424': OBJECT REQUIRED.

Anh chị hỗ trợ giúp em nhé.
Thanks--=0
Sửa CheckBox1.Value thành Sheet1.CheckBox1.Value
Sửa CheckBox2.Value thành Sheet1.CheckBox2.Value
Sửa CheckBox3.Value thành Sheet1.CheckBox3.Value
Sửa CheckBox4.Value thành Sheet1.CheckBox4.Value
 
Upvote 0
Xin hỏi thêm. Code trên có cách làm gọn hơn không vậy các Huynh.
Thanks
 
Upvote 0
Xin hỏi thêm. Code trên có cách làm gọn hơn không vậy các Huynh.
Thanks
Đưng nhiên có:
- Cho CheckBox1 link đến cell F3
- Cho CheckBox2 link đến cell F5
- Cho CheckBox3 link đến cell F7
- Cho CheckBox4 link đến cell F9
- Code sửa lại:
PHP:
Sub Test()
  Dim Cbox As OLEObject, Arr(), i As Long
  For Each Cbox In Sheet1.OLEObjects
    If InStr(Cbox.progID, "CheckBox") Then
      If Cbox.Object.Value Then
        With Sheet1.Range(Cbox.LinkedCell)
          If .Offset(, 2) > .Offset(, 4) Then
            i = i + 1
            ReDim Preserve Arr(1 To i)
            Arr(i) = Cbox.Object.Caption
          End If
        End With
      End If
    End If
  Next
  If i Then MsgBox Join(Arr, vbLf) & vbLf & "Please check it again"
End Sub
Và hàng đống cách khác có thể nghĩ ra, nhưng nói chung là sẽ dùng vòng lập để rút gọn
 

File đính kèm

Upvote 0
mình cũng bị lỗi tương tự khi chạy macro để add hình vào file.
giúp mình xem lỗi chỗ nào với.
lúc trước chạy được bình thường, nhưng mấy bữa nay hay xuất hiện lỗi này.

PHP:
Option Explicit
Sub AddPic()
Dim SelectRange As Range, n As Long, Answer1 As Integer
Dim LinkTo As String, LinkTo1 As String, DefaulLink As String
DefaulLink = "Y:\FOLLOW UP SAMPLE\Picture 0414"
Set SelectRange = Application.InputBox("Range", Type:=8)
Answer1 = MsgBox("Ban muon dung Defaul Link khong (Nhan Yes)? Hoac chon 1 Link moi den thu muc chua hinh anh? (Nhan NO)", vbYesNo)
If Answer1 = vbNo Then
    LinkTo = InputBox("Paste duong dan thu muc chua hinh anh vao day")
    LinkTo1 = LinkTo
Else
    LinkTo1 = DefaulLink
End If
Dim CellinRange As Range, Addr As String
On Error GoTo Badentry
For Each CellinRange In SelectRange
    CellinRange.Offset(0, -1).Select
    Selection.EntireRow.RowHeight = 85
    Addr = LinkTo1 & "\" & CellinRange.Value & ".JPG"
    ActiveSheet.Pictures.Insert(Addr).Select
    
    'Select lan luot cac picture trong sheet
    Selection.ShapeRange.Height = 75
    Selection.Placement = xlMoveAndSize
ResumNext:
Next
MsgBox "Finished", Title:="Prepared by Hvhue"
Exit Sub
Badentry:
MsgBox "This item havent in your folder picture" & vbNewLine & _
    "Please add more picture to folder."
Resume ResumNext
End Sub
 
Upvote 0
Giúp lỗi này

PHP:
<!DOCTYPE html PUBLIC "-//W3C//DTD HTML 4.01//EN"><html dir="ltr" xmlns:MSHelp="urn:schemas-microsoft-com:mshelp"><head><META http-equiv="Content-Type" content="text/html; charset=UTF-16">
<meta http-equiv="assetid" content="HV01202418"><!--csasset id="" date="2006-05-17"--><!--cstransform awsDeveloperHXS.xsl date 2006-08-24 --><!--
      csautotext date 2006-09-19 number --><!--
      csglossary date 2006-09-20 number --><!--
      csglobalstrings date 2006-09-05 number --><META NAME="lcid" CONTENT="1033"><title>Object required (Error 424)</title><script type="text/javascript" language="Javascript" src="office12.js"></script><link rel="stylesheet" type="text/css" href="ont.css"><link rel="stylesheet" type="text/css" href="contentHXS.css">
<SCRIPT LANGUAGE="javascript">
   var strShow='Show All';
   var strHide='Hide All';
   var strRtl='';
   var L_UNDEFINED_TEXT='Help could not locate this inline definition';
</SCRIPT>
  
    <STYLE TYPE="text/CSS">
	    .ACICollapsed
	    {
		    display: none;
	    }

	    .ACECollapsed
	    {
		    display: none;
	    }
          
      <!--to wrap the table text when the page is re-sized-->
      table
      {
          word-break:break-all;
      }
    </STYLE>

    <NOSCRIPT>
	    <STYLE TYPE="text/CSS">
		    .ACICollapsed
		    {
			    display: inline;
		    }

		    .ACECollapsed
		    {
			    display: block;
		    }
	    </STYLE>
    </NOSCRIPT>

	    <SCRIPT>
		    function go(url)
		    {
			    window.open(url, "_self");
		    }

		    function OpenInNewWindow(url)
		    {
			    go(url);
		    }
	    </SCRIPT>




	    <script type="text/JavaScript" language="JavaScript">
	    <!--

    function InlineDefNotFound() { alert(L_UNDEFINED_TEXT); }
    function AppendPopup(oSource, sPopup)
    {
	    InitializeGlobalData();
	    if (typeof(allDivsInPage) == 'undefined' || null == allDivsInPage) return;
	    var theDiv = allDivsInPage['divInlineDef_' + sPopup];
	    if (typeof(theDiv) == 'undefined' || null == theDiv)
		    {
		    InlineDefNotFound();
		    return;
		    }
	    if (theDiv.style.display.toUpperCase() != 'INLINE')
		    theDiv.style.display = 'inline';
	    else
		    theDiv.style.display = 'none';
    }

    //-->
    </script>
     </head><body class="clientViewer"><div class="cdclvBreadcrumbs cdbread"><span><a class="OAnc" href="#" onclick="javascript:GoOfflineParentCategory(0)">Excel 2007 Developer Reference</a> &gt; <a class="OAnc" href="#" onclick="javascript:GoOfflineParentCategory(1)">Visual Basic for Applications Language Reference</a> &gt; <a class="OAnc" href="#" onclick="javascript:GoOfflineParentCategory(2)">Visual Basic Language Reference</a> &gt; <a class="OAnc" href="#" onclick="javascript:GoOfflineParentCategory(3)">Error Messages</a></span></div><!--content HTML starts here--><div class="cdclvSection"><div class="devdocvsbody"><div id="header"><table width="100%" id="topTable"><tr id="headerTableRow1"><td align="left"><span id="runningHeaderText"></span></td></tr><tr id="headerTableRow2"><td align="left"><span id="nsrTitle"><b class="mainheaders">Object required (Error 424)</b></span></td></tr></table></div><p>References to <a href="HV01200929.htm">properties</a> and <a href="HV01200929.htm">methods</a> often require an explicit object qualifier. This error has the following causes and solutions:</p><p><ul type="disc">
<li>You referred to an object property or method, but didn't provide a valid object qualifier.
<p>Specify an object qualifier if you didn't provide one. For example, although you can omit an object qualifier when referencing a form property from within the form's own <a href="HV01200929.htm">module</a>, you must explicitly specify the qualifier when referencing the property from a <a href="HV01200929.htm">standard module</a>.</p>
</li>
<li>You supplied an object qualifier, but it isn't recognized as an object.
<p>Check the spelling of the object qualifier and make sure the object is visible in the part of the program in which you are referencing it. In the case of <b class="bterm">Collection</b> objects, check any occurrences of the <b class="bterm">Add</b> method to be sure the syntax and spelling of all the elements are correct.</p>
</li>
<li>You supplied a valid object qualifier, but some other portion of the call contained an error.
<p>An incorrect path as an <a href="HV01200929.htm">argument</a> to a <a href="HV01200929.htm">host application's</a> <b class="bterm">File Open</b> command could cause the error. Check arguments.</p>
</li>
<li>You didn't use the <b class="bterm">Set</b> statement in assigning an object reference.
<p>If you assign the return value of a <b class="bterm">CreateObject</b> call to a <b class="bterm">Variant</b> variable, an error doesn't necessarily occur if the <b class="bterm">Set</b> statement is omitted. In the following code example, an implicit instance of Microsoft Excel is created, and its default property (the string "Microsoft Excel") is returned and assigned to the <b class="bterm">Variant</b> <div id="vstable"><table><tr><td><pre><code>RetVal</code></pre></td></tr></table></div>. A subsequent attempt to use <div id="vstable"><table><tr><td><pre><code>RetVal</code></pre></td></tr></table></div> as an object reference causes this error:</p>

<div id="vstable"><table><tr><td><pre><code>Dim RetVal                                ' Implicitly a Variant.
' Default property is assigned to Type 8 Variant RetVal.
RetVal = CreateObject("Excel.Application")    
RetVal.Visible = True                ' Error occurs here.
</code></pre></td></tr></table></div>

<p>Use the <b class="bterm">Set</b> statement when assigning an object reference.</p>
</li>
<li>In rare cases, this error occurs when you have a valid object but are attempting to perform an invalid action on the object. For example, you may receive this error if you try to assign a value to a read-only property.
<p>Check the object's documentation and make sure the action you are trying to perform is valid.</p>
</li> </ul></p><p>For additional information, select the item in question and press F1 (in Windows) or HELP (on the Macintosh).</p><META NAME="CreationDate" CONTENT="2005-01-01"></div></div></body></html>
 
Upvote 0
E cũng bị lỗi này runtime error 424 nhờ anh chị sửa giúp. Lỗi ngay dòng em bôi đỏ
Private Sub UserForm_Activate()
Sheets("DTCT").Select
TopRow = Cells.Find("DuToanChiTiet").Row
BotRow = Cells.Find("KetThucDuToan").Row
If DbConDG Is Nothing Then
Set DbConDG = CreateObject("ADODB.Connection")
DbConDG.Open "Provider = Microsoft.Jet.OLEDB.4.0;Data Source=" & ThisWorkbook.Path & "\DonGia1728.mdb"
End If
Set RsDmcv = CreateObject("ADODB.RecordSet")
RsDmcv.Open "SELECT * FROM [DonGia]", DbConDG, adOpenKeyset, adLockPessimistic
UpdataToListBox
End Sub
Private Sub UpdataToListBox()
Dim RsCV As ADODB.Recordset
Set RsCV = CreateObject("ADODB.RecordSet")
RsCV.Open "SELECT MADG, TENCV FROM [DonGia]", DbConDG, adOpenKeyset, adLockPessimistic
Dim rcArray As Variant
rcArray = RsCV.GetRows
With LstDMCV
.Clear
If LBound(rcArray, 2) = UBound(rcArray, 2) Then
.AddItem rcArray(LBound(rcArray, 1), LBound(rcArray, 2))
.List(0, 1) = rcArray(LBound(rcArray, 1) + 1, LBound(rcArray, 2))
Else
.List = Application.Transpose(rcArray)
End If
.ListIndex = -1
End With
RsCV.Close
Set RsCV = Nothing
End Sub
Private Sub UserForm_Deactivate()
RsDmcv.Close
DbConDG.Close
Set RsDmcv = Nothing
Set DbConDG = Nothing
End Sub
 

File đính kèm

Upvote 0
Với fương thức Find() thì sẽ gây lỗi khi không tìm thấy ô cần tìm.
& rõ ràng trên trang tính bạn đưa lên làm gì có cụm từ "DuToanChiTiet"
Trên trang này của file chỉ có cụm từ "DỰ TOÁN CHI TIẾT" mà thôi!
Để thoát khỏi lỗi này, bạn cần khai báo thêm 1 tham biến kiểu Range

&
Set Rng = Cells.Find("GPE.COM")
If Rng Is Nothing then
MsgBox "Nothing"
Else
TopRow = Cells.Find("GPE.COM").Row
End If

Nhân dịp năm mới cận kề: Xin chúc bạn nhiều niềm vui & kết quả!
 
Upvote 0
Với fương thức Find() thì sẽ gây lỗi khi không tìm thấy ô cần tìm.
& rõ ràng trên trang tính bạn đưa lên làm gì có cụm từ "DuToanChiTiet"
Trên trang này của file chỉ có cụm từ "DỰ TOÁN CHI TIẾT" mà thôi!
Để thoát khỏi lỗi này, bạn cần khai báo thêm 1 tham biến kiểu Range

&
Set Rng = Cells.Find("GPE.COM")
If Rng Is Nothing then
MsgBox "Nothing"
Else
TopRow = Cells.Find("GPE.COM").Row
End If

Nhân dịp năm mới cận kề: Xin chúc bạn nhiều niềm vui & kết quả!
Mình cũng chúc bạn năm mới vui vẻ hạnh phúc. Trong file mình đính kèm có cụm từ "DuToanChiTiet" và "KetThucDuToan" ở hàng số 4 và hàng 30 đó bạn. (file bị ẩn 2 dòng đó)
 
Lần chỉnh sửa cuối:
Upvote 0
E cũng bị lỗi này runtime error 424 nhờ anh chị sửa giúp. Lỗi ngay dòng em bôi đỏ
Private Sub UserForm_Activate()
Sheets("DTCT").Select
TopRow = Cells.Find("DuToanChiTiet").Row
BotRow = Cells.Find("KetThucDuToan").Row
If DbConDG Is Nothing Then
Set DbConDG = CreateObject("ADODB.Connection")
DbConDG.Open "Provider = Microsoft.Jet.OLEDB.4.0;Data Source=" & ThisWorkbook.Path & "\DonGia1728.mdb"
End If
Set RsDmcv = CreateObject("ADODB.RecordSet")
RsDmcv.Open "SELECT * FROM [DonGia]", DbConDG, adOpenKeyset, adLockPessimistic
UpdataToListBox
End Sub
Private Sub UpdataToListBox()
Dim RsCV As ADODB.Recordset
Set RsCV = CreateObject("ADODB.RecordSet")
RsCV.Open "SELECT MADG, TENCV FROM [DonGia]", DbConDG, adOpenKeyset, adLockPessimistic
Dim rcArray As Variant
rcArray = RsCV.GetRows
With LstDMCV
.Clear
If LBound(rcArray, 2) = UBound(rcArray, 2) Then
.AddItem rcArray(LBound(rcArray, 1), LBound(rcArray, 2))
.List(0, 1) = rcArray(LBound(rcArray, 1) + 1, LBound(rcArray, 2))
Else
.List = Application.Transpose(rcArray)
End If
.ListIndex = -1
End With
RsCV.Close
Set RsCV = Nothing
End Sub
Private Sub UserForm_Deactivate()
RsDmcv.Close
DbConDG.Close
Set RsDmcv = Nothing
Set DbConDG = Nothing
End Sub

Đoán là do biến DbConDG
chưa được khai báo.

dim DbConDG as object

cho câu lệnh trên ở đầu modun xem.
 
Upvote 0
Cho đoạn code sau vào đầu code của FormDonGia
Mã:
Option Explicit

Dim RsDmcv As ADODB.Recordset
Dim TopRow As Long, BotRow As Long
Dim DbConDG As ADODB.Connection
Có file DonGia1728.mdb không để mà test hả cậu ?
 
Upvote 0

File đính kèm

Upvote 0
Còn sữa code nhiều lắm, ví dụ 1 loạt TxtXXX, CmdXXX chưa có, khai báo sai name...
Bạn cứ làm từ từ đi
 
Upvote 0
Đoán là do biến DbConDG
chưa được khai báo.

dim DbConDG as object

cho câu lệnh trên ở đầu modun xem.
Thêm dim vào là khắc phục được lỗi runtime error 424. Nhưng phát sinh thêm lỗi Runtume error 3001 "agruments are off the wrong type, are out of accesstable range, or are in conflict with one another"
Debug tại dòng "RsDmcv.Open "SELECT * FROM [DonGia]", DbConDG, adOpenKeyset, adLockPessimistic"
 
Upvote 0
Bạn thêm mấy dòng code tui post ở trên vào chưa ?
 
Upvote 0
Thêm đủ vào đi.
 
Upvote 0
OK, đúng rồi bạn. Nhưng lại sảy ra lỗi runtime error 3001 như trên với dòng lệnh:
RsCV.Open "SELECT MADG, TENCV FROM [DonGia]", DbConDG, adOpenKeyset, adLockPessimistic.
bạn có thể sửa giúp mình?
Phần còn lại bạn tự chỉnh nốt.
 

File đính kèm

Upvote 0
Trong Win64, rất thường chuỗi Provider = Microsoft.Jet.OLEDB.4.0 sẽ không chạy được nhé, do MS không support cho Access DLL 64bit.
 
Upvote 0
Bị báo lỗi RUNTIME ERROR '1004': Application-defined or object-defined error
Anh chị hổ trợ giúp em với.
 

File đính kèm

Upvote 0
Bị báo lỗi RUNTIME ERROR '1004': Application-defined or object-defined error
Anh chị hổ trợ giúp em với.
Mã:
Private Sub TextBox1_Change()
  If Len(TextBox1.Value) Then
    Range("A3", Range("E" & Rows.Count).End(xlUp)).AutoFilter Field:=2, Criteria1:="*" & TextBox1.Value & "*"
  Else
    Sheets("Sheet2").AutoFilterMode = False
    If Len(TextBox2.Value) Then
      Range("A3", Range("E" & Rows.Count).End(xlUp)).AutoFilter Field:=4, Criteria1:="*" & TextBox2.Value & "*"
    End If
  End If
End Sub
Private Sub TextBox2_Change()
  If Len(TextBox2.Value) Then
    Range("A3", Range("E" & Rows.Count).End(xlUp)).AutoFilter Field:=4, Criteria1:="*" & TextBox2.Value & "*"
  Else
    Sheets("Sheet2").AutoFilterMode = False
    If Len(TextBox1.Value) Then
      Range("A3", Range("E" & Rows.Count).End(xlUp)).AutoFilter Field:=2, Criteria1:="*" & TextBox1.Value & "*"
    End If
  End If
End Sub
 
Upvote 0
Cảm ơn Anh , đã thực hiện được file rồi .
 
Upvote 0
Mọi người giúp em với
Em in mà nó bán lỗi
-------------
Sub printF()
Dim k As Long, printFrom As Long, printTo As Long
printFrom = Sheet2.Range("k13").Value
printTo = Sheet2.Range("k14").Value
For k = printFrom To printTo
Sheet2.Range("k11").Value = k
Sheet2.PrintOut Preview:=False
Next k
End Sub
 
Upvote 0
Nó BÁN lỗi cho ai? Lỗi lầm ra làm sao? Giá bao nhiêu?

Mã:
Sub printF()
Dim k As Long, printFrom As Long, printTo As Long
printFrom = val(Sheet2.Range("k13").Value)
printTo = val(Sheet2.Range("k14").Value)
If printFrom <= printTo Then
For k = printFrom To printTo
    Sheet2.Range("K11").Value = k
    Sheet2.PrintOut
Next k
End If
End Sub
 
Upvote 0
Nó BÁN lỗi cho ai? Lỗi lầm ra làm sao? Giá bao nhiêu?

Mã:
Sub printF()
Dim k As Long, printFrom As Long, printTo As Long
printFrom = val(Sheet2.Range("k13").Value)
printTo = val(Sheet2.Range("k14").Value)
If printFrom <= printTo Then
For k = printFrom To printTo
    Sheet2.Range("K11").Value = k
    Sheet2.PrintOut
Next k
End If
End Sub
1. printFr là đủ hiểu rồi, không cần phải đầy đủ từ 'From' (trong môi trường VBE, font Courier sẽ cho thấy các từ có số ký tự bằng nhau sẽ sắp ngay hàng nhau)
2. For k = val(Sheet2.Range("k13").Value) To val(Sheet2.Range("k14").Value)
Nếu Fr > To thì tự động vòng lặp không chạy, khong cần phải xét trước
(bình thường thì i là chỉ số đếm vòng lặp. Khi ngừoi có kinh nghiệm đọc code thấy bạn dùng k thì ngừoi ta sẽ đoán bạn cố tình dùng k với lý do gì đó)

Chú: tôi thấy bạn thích học viết code thì tôi chỉ dẫn các style viết code. Nếu bạn phật ý thì nói thẳng ra, tôi sẽ không làm nữa.
 
Upvote 0
Chú: tôi thấy bạn thích học viết code thì tôi chỉ dẫn các style viết code. Nếu bạn phật ý thì nói thẳng ra, tôi sẽ không làm nữa.
Chắc chắn là không (phật ý) rồi anh.
1. printFr là đủ hiểu rồi, không cần phải đầy đủ từ 'From' (trong môi trường VBE, font Courier sẽ cho thấy các từ có số ký tự bằng nhau sẽ sắp ngay hàng nhau)
2. For k = val(Sheet2.Range("k13").Value) To val(Sheet2.Range("k14").Value)
Nếu Fr >= To thì tự động vòng lặp không chạy, khong cần phải xét trước
(bình thường thì i là chỉ số đếm vòng lặp. Khi ngừoi có kinh nghiệm đọc code thấy bạn dùng k thì ngừoi ta sẽ đoán bạn cố tình dùng k với lý do gì đó)
Em chép lại nội dung rồi thêm hàm Val(), chứ không có ý định chỉnh lại bài.
Chỗ xét Fr >= To đúng là em không để ý vòng lặp bỏ qua. :)
Em nghi ngờ (đoán) tại ô K13 và K14 là một hàm có khả năng trả về lỗi nhưng chỉ lướt qua bài rồi thêm hàm Val().
 
Upvote 0
Chắc chắn là không (phật ý) rồi anh.

Em chép lại nội dung rồi thêm hàm Val(), chứ không có ý định chỉnh lại bài.
Chỗ xét Fr >= To đúng là em không để ý vòng lặp bỏ qua. :)
Em nghi ngờ (đoán) tại ô K13 và K14 là một hàm có khả năng trả về lỗi nhưng chỉ lướt qua bài rồi thêm hàm Val().
-------
em mới học nên không biết sửa làm sao
anh có thể giúp em chỉnh lại cho nó chạy được không ạ
em cám ơn nhiều ạ
Bài đã được tự động gộp:

1. printFr là đủ hiểu rồi, không cần phải đầy đủ từ 'From' (trong môi trường VBE, font Courier sẽ cho thấy các từ có số ký tự bằng nhau sẽ sắp ngay hàng nhau)
2. For k = val(Sheet2.Range("k13").Value) To val(Sheet2.Range("k14").Value)
Nếu Fr > To thì tự động vòng lặp không chạy, khong cần phải xét trước
(bình thường thì i là chỉ số đếm vòng lặp. Khi ngừoi có kinh nghiệm đọc code thấy bạn dùng k thì ngừoi ta sẽ đoán bạn cố tình dùng k với lý do gì đó)

Chú: tôi thấy bạn thích học viết code thì tôi chỉ dẫn các style viết code. Nếu bạn phật ý thì nói thẳng ra, tôi sẽ không làm nữa.
cám ơn bro nhiều bro góp í như vậy là quá tốt rồi sao phật ý được
 
Upvote 0
Upvote 0
Mình làm như này mà bị báo lỗi
Các cao nhân giúp đỡ với ạ. Chỗ mình bôi đậm ý

Sub Sapxepdulieu()
'
' Sapxepdulieu Macro
' Sap xep du lieu theo thu tu cho truoc
'

'
ActiveWorkbook.Worksheets("Total_Farm").Sort.SortFields.Clear
ActiveWorkbook.Worksheets("Total_Farm").Sort.SortFields.Add Key:=ActiveCell. _
Offset(0, 10).Range("A1:A290"), SortOn:=xlSortOnValues, Order:=xlAscending, _
DataOption:=xlSortNormal
ActiveWorkbook.Worksheets("Total_Farm").Sort.SortFields.Add Key:=ActiveCell. _
Offset(0, 3).Range("A1:A290"), SortOn:=xlSortOnValues, Order:=xlAscending, _
DataOption:=xlSortNormal
ActiveWorkbook.Worksheets("Total_Farm").Sort.SortFields.Add Key:=ActiveCell. _
Offset(0, 2).Range("A1:A290"), SortOn:=xlSortOnValues, Order:=xlAscending, _
DataOption:=xlSortNormal
ActiveWorkbook.Worksheets("Total_Farm").Sort.SortFields.Add Key:=ActiveCell. _
Offset(0, 1).Range("A1:A290"), SortOn:=xlSortOnValues, Order:=xlAscending, _
DataOption:=xlSortNormal
ActiveWorkbook.Worksheets("Total_Farm").Sort.SortFields.Add Key:=ActiveCell. _
Range("A1:A290"), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption _
:=xlSortNormal
ActiveWorkbook.Worksheets("Total_Farm").Sort.SortFields.Add Key:=ActiveCell. _
Offset(0, 6).Range("A1:A290"), SortOn:=xlSortOnValues, Order:=xlAscending, _
DataOption:=xlSortNormal
ActiveWorkbook.Worksheets("Total_Farm").Sort.SortFields.Add Key:=ActiveCell. _
Offset(0, 4).Range("A1:A290"), SortOn:=xlSortOnValues, Order:=xlAscending, _
DataOption:=xlSortNormal
With ActiveWorkbook.Worksheets("Total_Farm").Sort
.SetRange ActiveCell.Offset(-1, 0).Range("A1:N291")
.Header = xlYes
.MatchCase = False
.Orientation = xlTopToBottom
.SortMethod = xlPinYin
.Apply
End With
End Sub
Sub Luudulieuvaobang()
' 1. Luu du lieu vao bang
'1.1. Tim dong cuoi cua bang data
Dim DongCuoi As Long
DongCuoi = Total_Farm.Cells(Rows.Count, 1).End(xlUp).Row + 1
'1.2. Luu du lieu vao dong cuoi
Total_Farm.Range("C" & DongCuoi & ":" & "P" & DongCuoi).Value = Total_Farm.Range("C7: P7").Value
' 2. Xoa du lieu o nhap vao
Total_Farm.Range("C7:K7").ClearContents
' 3. Sap xep du lieu trong bang
Call Sapxepdulieu
'Thong bao hoan thanh
MsgBox "Da xong, nen kiem tra lai"
End Sub
 
Lần chỉnh sửa cuối:
Upvote 0
xin chào tất cả mọi người
các cao nhân giúp em với
em đang học làm 1 form nhập dữ liệu
ấn chạy nó báo lỗi 424
các cao nhân sửa file giúp em với
file đính kèm bên dưới ah .
thanks
 

File đính kèm

Upvote 0
PHP:
Private Sub UserForm_Initialize()
    Dim setting As Variant
    Dim index As Long
    Dim label As MSForms.label
    Dim textbox As MSForms.textbox
On Error GoTo LoiCT
    currentTopPos = 20
    With Sheets(SHEET_SETTINGS)
        settings = .Range("A2:D2" & getLR(.Name, "D")).Value
        
        For index = LBound(settings, 1) To UBound(settings, 1)
            With Me
                Set label = .Controls.Add("Forms.label.1")
                With label
                    .Left = UI_LEFT
                    .Top = currentTopPos
                    .Width = settings(index, 4)
                    .Height = UI_LINE_HEIGHT
                    currentTopPos = .Top + .Height + UI_GAP
                    .Caption = settings(index, 2)
                End With
                Set textbox = .Controls.Add("Forms.textbox.1")
                With textbox
                    .Name = settings(index, 1)
                    .Left = UI_LEFT
                    .Top = currentTopPos
                    .Width = settings(index, 4)
                    .Height = settings(index, 3) * UI_LINE_HEIGHT
                    If settings(index, 3) > 1 Then .MultiLine = True
                    currentTopPos = .Top + .Height + UI_GAP
         End With
         .Height = 300
         .Width = 380
         .Caption = "bangdanhgia"
1        End With
     Next index
3   End With
    With cmdSaveData
5    .Top = currentTopPos
6    .Left = 310 - cmdSvaeData.Width
7    End With
Err_:               Exit Sub
LoiCT:
    If Err = 424 Then
        MsgBox Erl, , "Dòng Lênh Dang Sai:"
        Resume Next
    Else
        Resume Err_
    End If
End Sub
 
Upvote 0
[bác kiểm tra giúp em với, em viết đoạn code bên dưới bị báo lỗi 424 dòng, objsheet.cells(irow,6)=1

Sub change_quota()

Dim V_Material, V_Component, V_ECNnumber, V_Quota
Dim lineitems As Long


'Set the line status to "processing..."

objSheet.Cells(iRow, 6) = 1

'Material
If objSheet.Cells(iRow, 8) <> "" Then
V_Material = objSheet.Cells(iRow, 8)
Else
V_Material = "xxxxxx"
End If

'Component
If objSheet.Cells(iRow, 9) <> "" Then
V_Component = objSheet.Cells(iRow, 9)
Else
V_Component = ""
End If

'ECN Change
If objSheet.Cells(iRow, 5) <> "" Then
V_ECNnumber = objSheet.Cells(iRow, 5)
Else
V_ECNnumber = ""
End If

'Quota
If objSheet.Cells(iRow, 11) <> "" Then
V_Quota = objSheet.Cells(iRow, 11)
Else
V_Quota = ""
End If
 
Upvote 0

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

Back
Top Bottom