請問這VBA 程式碼錯誤的地方是有什麼問題呢?

本帖最後由 jeffrey628litw 於 2019-6-21 12:44 編輯

請問這VBA 程式碼錯誤的地方是有什麼問題呢?

'002頁

         Sheets("昨日").Cells(v, 9).ClearContents

         Sheets("昨日").Cells(v, 10).ClearContents

         Sheets("昨日").Cells(v, 11).ClearContents

         Sheets("昨日").Cells(v, 12).ClearContents

   End If
Next
Next
ActiveWorkbook.Worksheets("昨日").Sort.SortFields.Clear

ActiveWorkbook.Worksheets("昨日").Sort.SortFields.Add2 Key:=Range("e2:e99") _             --------------------------->這行會出現問題
, SortOn:=xlSortOnValues, Order:=x1Ascending, DataOption:=xlSortNormal                   --------------------------->這行會出現問題

With ActiveWorkbook.Worksheets("昨日").Sort
   .SetRange Range("C1:199")
   .Header = xlYes
   .MatchCase = False
   .Orientation = xlTopToBottom
   .SortMethod = xlPinYin
   .Apply
  End With


'填上昨日轉速、昨日M

r = 2

r1 = 2

Do While Sheets("昨日").Cells(r, 5) <> ""

Do While Sheets("參數").Cells(rl, 1) <> ""

   If Sheets("昨日").Cells(r, 5) = Sheets("參數").Cells(rl, 1) Then

      Sheets("參數").Cells(rl, 5) = Round(Sheets("昨日").Cells(r, 6) * 60 * 18 / 1000, 0)

  End If

r1 = r1 + 1

Loop

r1 = 2

r = r + 1

Loop

'開始進行製令單日數計算作業

Range("AK3:AMIOO").ClearContents

Range("AQ3 :BL38").ClearContents

For i = 4 To 2000 '大排程起迄列數，估2000列，清除左欄各第三格的內容，以符程式所需

If InStr(Sheets("排程複製").Cells(i + 1, 1).Value, "月") <> 0 Then

   Sheets("排程複製").Cells(i, l).ClearContents

End If

'003頁

檔案下載：

20190621 VBA 自動產生排程 v.02.rar (33.83 KB)

樓主熱帖

n7822123

　暱稱: 阿龍

中學生 Rank: 2

帖子: 406
主題: 8
精華: 0
積分: 453
點名: 0
作業系統: WINDOWS 7
軟體版本: 2007
閱讀權限: 20
性別: 男
來自: 台灣
註冊時間: 2015-2-7
最後登錄: 2021-7-31

2^#

發表於 2019-6-22 12:14 | 只看該作者

回復 1# jeffrey628litw

感覺在玩大家來找碴.............

ActiveWorkbook.Worksheets("昨日").Sort.SortFields.Add2 Key:=Range("e2:e99") _
, SortOn:=xlSortOnValues, Order:=x1Ascending, DataOption:=xlSortNormal

多了個"2"，1 改成 "L"
正確寫法如下

ActiveWorkbook.Worksheets("昨日").Sort.SortFields.Add Key:=Range("e2:e99") _
, SortOn:=xlSortOnValues, Order:=xLAscending, DataOption:=xlSortNormal

程式是依需求寫的，需求表達不清楚
或者沒有上傳附件，愛莫能助

TOP

jeffrey628litw

中學生 Rank: 2

帖子: 228
主題: 62
精華: 0
積分: 364
點名: 20
作業系統: Win 10
軟體版本: Office 2007 & 2010
閱讀權限: 20
性別: 男
註冊時間: 2011-3-5
最後登錄: 2024-9-16

2011兔年全勤獎章

3^#

發表於 2019-6-22 14:53 | 只看該作者

回復 2# n7822123

謝謝大大幫忙，我昨晚還爬文找日本網站，結果沒對照出來，謝謝您。

接下來還有問題，這程式碼

         order1 = 0 '製令單天數

         Change = 0 '換規格總時間

         hr3 = 0

         b = 48

         i1 = i

'004 頁

      il1 = i1 + 12

      a = a + 1

   End If

End If

  '一週兩規的排法，但無上規，須先計算


   If j > 1 And Sheets("排程複製").Cells(i, 1) <> "" And InStr(Sheets("排程複製").Cells(i, 1).Value, "月") = 0 And Sheets("排程複製").Cells(i, j) = "" And Len(Sheets("排程複製").Cells(i + 2, j)) > 10 And Len(Sheets("排程複製").CeIls(i + 3, j)) > 10 And InStr(Sheets("排程複製").Cells(i + 2, j).Value, "已計算過") = 0 Then                                  -------------------->這一行有問題

         If InStr(Sheets("排程複製").Cells(i + 2, j).Value, "-") = 0 Or InStr(Sheets("排程複製").Cells(i + 2, j).Value, "-") > 19 Then '沒有連接符號，或連接符號在第20位元以後，因為有的客戶名稱有連接符號

         e = Sheets("排程複製").Cells(i + 3, j).Value '包含線材、數量的儲存格

         el = Sheets("排程複製").Cells(i + 2, j).Value '包含規格的儲存格

         i1 = i + 2

         If InStr(Sheets("排程複製").CelIs(i + 2, j).NoteText, Sheets("昨日").Cells(a - 2, 3).Value) <> 0 Then '如果是現行製令的儲存格

         CURR = 1



         HRS = Mid(e, InStr(e, "-1") + 1, Len(e) - InStr(e, "-")) '開始取線徑、形狀，第一個連接符號後，繼續取線徑、形狀

         If InStr(Left(HRS, 6), "H") <> 0 Then

         HRS = Left(HRS, InStr(num, "H"))


         End If

         If InStr(Left(HRS, 6), "R") <> 0 Then

         HRS = Left(HRS, InStr(num, "R"))


         If InStr(Left(HRS, 6), "S") <> 0 Then

         HRS = Left(HRS, InStr(num, "S"))


         End If


         End If

         If CURR = 1 Then


            If Sheets("排程複製").Cells(i1, j).Interior.Colorlndex = 37 Or Sheets("排程複製").Cells(il, j).Interior.ColorIndex = 20 Or Sheets("排程複製").Cells(i1, j).Interior.Colorlndex = 24 Then    '有製令且非移單者

            ' Call MM123(a, b, c, e, el, i, il, j, hrl, hr2, hr3, item0, iteml, HRS0, HRS, orderl)

   item0 = Item '存為前規格

   HRS0 = HRS

            End If

         End If

'005 頁

         Sheets("排程複製").Cells(i + 2, j).Value = "已計算過" & Sheets("排程複製").Cells(i + 2, j).Value


      End If

End If

檔案下載：

20190622 VBA 自動產生排程 v.3.rar (28.15 KB)

TOP

n7822123