اذهب الي المحتوي
أوفيسنا

الردود الموصى بها

قام بنشر

السلام عليكم أساتذتى الكرام ... أرجو من حضراتكم التعطف على مساعدتى فى الأتى :

يطلعلي ها الرسالة اول ما افتح الاكسل

Constants, fixed-length strings, arrays, user-defined types, and Declare statements not allowed as Public members of an object module

تجنباً لإهدار وقت الأساتذة دون جدوى ... ان لم يتم رفع الملف , فعذراً ستحذف المشاركة

قام بنشر

وعليكم السلام -تفضل هذا الحل بما انك لم تقم برفع الملف الذى يحتوى على الكود الذى به المشكلة .. فإن لم تستطع التطبيق وحل مشكلتك ... فلابد لزاماً من رفع الملف للوقوف على المشكلة والعمل على حلها من قبل الأساتذة وشكرا .

Compile error: Constants, ...Declare statements not allowed

وهذا كود أخر ... ولكنى لا أعلم هل سيفيد مشكلتك ام لا لأنه لا يمكن العمل على التخمين !!!

Option Explicit
Dim wb                                  As Workbook
Dim Cell, rng                           As Range
Dim A(1 To 4)                           As String
Dim arrData()                           As Variant
Dim arrRow, lRow, lCol                  As Long
Dim i1, i2, j1, j2                      As Long
'Public ListGroup()
Public Sub ArrayToFinnish()
    Dim Cell As String
    Dim aCell As Range
    A(1) = "Ship Via Description"
    A(2) = "Speditor"
    A(3) = "Planned Ship Date/Time"
    A(4) = "Weight"
    'A(4) = "Customer Order"
    'A(5) = "Customer Number"
    Sheet1.Activate
    lRow = Sheet1.Cells.Find(What:="*", LookIn:=xlValues, SearchDirection:=xlPrevious, SearchOrder:=xlByRows).row
    lCol = Sheet1.Cells.Find(What:="*", LookIn:=xlValues, SearchDirection:=xlPrevious, SearchOrder:=xlByColumns).Column
    Set rng = Sheet1.Range(Sheet1.Cells(1, 1), Sheet1.Cells(1, lCol))
    ReDim arrData(1 To lRow, 1 To UBound(A, 1))
    'ListGroup = arrData(1 To lRow, 1 To Ubound(A,1))
    For i1 = 2 To lRow
        For j1 = 1 To UBound(A, 1)
            Set aCell = rng.Find(A(j1))
            Cell = Sheet1.Cells(i1, aCell.Column).Value
            Select Case Cell
                 Case Cell = "EXPRESS"
                 Case Cell = "TRUCK"
                 Case Cell = "CZ/DACHSER/Axis Communications LLC"
                 Case Cell = "DE/ASH Logistik/Abris"
                 Case Cell = "DE/EXP Cargo/RRC Cent. Asia"
                 Case Cell = "HU/Trans-Gate/IQ Trading"
                 Case Cell = "USA/Atlanta/Splitpoint"
                 Case "AIRFREIGHT"
                    arrRow = arrRow + 1
                    KN
                 Case Cell = "China/Shanghai/Splitpoint"
                 Case Cell = "Singapore/KN/CDP"
                 Case Cell = "US/Geodis/Miami"
                 Case Cell = "BR/Sao Paulo/Splitpoint"
                 Case Cell = "Japan / Multitek / Warehouse"
            End Select
        Next j1
    Next i1
End Sub
Private Sub KN()
    Dim ws                              As Worksheet
    Dim KCell, KCellD, KCellW           As Range
    'Dim j3                              As Long
    Dim D                               As Date
    Set wb = ThisWorkbook
    lRow = Sheet1.Cells.Find(What:="*", LookIn:=xlValues, SearchDirection:=xlPrevious, SearchOrder:=xlByRows).row
    lCol = Sheet1.Cells.Find(What:="*", LookIn:=xlValues, SearchDirection:=xlPrevious, SearchOrder:=xlByColumns).Column
    Set ws = wb.ActiveSheet
    Set rng = Sheet1.Range(Sheet1.Cells(1, 1), Sheet1.Cells(1, lCol))
    Set KCellD = rng.Find(A(3))
    Set KCellW = rng.Find(A(4))
    With ws
        ' ****** Getting an error here , you are not setting KCell Range ******
        D = .Cells(i1, KCell.Column)
        Select Case D
            Case DateAdd("d", 1, Date)
                If .Cells(i1, KCellW.Column).Value >= 50 Then
                    For j2 = 1 To UBound(A, 1)
                        arrData(arrRow, j2) = .Cells(i1, j2).Value
                    Next j2
                End If
            Case DateAdd("d", 2, Date)
                If .Cells(i1, KCellW.Column).Value >= 1000 Then
                    For j2 = 1 To UBound(A, 1)
                        arrData(arrRow, j2) = .Cells(i1, j2).Value
                    Next j2
                End If
            Case Else ' not sure why need, you are not using it
        End Select
    End With
End Sub

 

  • Like 1

Join the conversation

You can post now and register later. If you have an account, sign in now to post with your account.

زائر
اضف رد علي هذا الموضوع....

×   Pasted as rich text.   Paste as plain text instead

  Only 75 emoji are allowed.

×   Your link has been automatically embedded.   Display as a link instead

×   Your previous content has been restored.   Clear editor

×   You cannot paste images directly. Upload or insert images from URL.

  • تصفح هذا الموضوع مؤخراً   0 اعضاء متواجدين الان

    • لايوجد اعضاء مسجلون يتصفحون هذه الصفحه
×
×
  • اضف...

Important Information