12
返回列表 上一主題 發帖

[發問] 關於此段程式碼的改進以及說明?

starry1314
　暱稱: 豪

高中生Rank: 3Rank: 3

帖子
471 
主題
121 
精華
0 
積分
579 
點名
0  
作業系統
WIN10 
軟體版本
OFFICE2019 
閱讀權限
50 
性別
男 
註冊時間
2015-4-16 
最後登錄
2023-1-17 
1# 跳轉到 » 倒序看帖
打印
tT
發表於 2015-6-30 14:40 | 只看該作者

[發問] 關於此段程式碼的改進以及說明?

本帖最後由 starry1314 於 2015-6-30 14:43 編輯

功能:以C2儲存格的單一條件作為判斷
希望:C2多條件判斷 以【,】 C2=紅,糖 即傳回最後一項有此條件的下一道菜
或是有大大可以幫註明以下程式碼的解說,好讓自行改進嗎?\


出現指定禁忌,跳往最後一項禁忌 往下一道菜.rar (18.15 KB)
  1. Sub 避開禁忌()
  2. Dim arr, str, i&, k&, n&, brr
  3. On Error Resume Next
  4. str = [c2].Value
  5. arr = Sheets("data").[a1].CurrentRegion
  6. ReDim brr(1 To UBound(arr) + 1, 1 To 2)
  7.     For i = 1 To UBound(arr)
  8.         For j = 1 To UBound(arr, 2) Step 2
  9.             If InStr(arr(i, j + 1), str) Then
  10.                 k = k + 1
  11.                 n = k + 1
  12.                 brr(k, 1) = arr(i, j)
  13.                 brr(k, 2) = arr(i, j + 1)
  14.                 brr(n, 1) = arr(i, j + 2)
  15.                 brr(n, 2) = arr(i, j + 3)
  16.             End If
  17.         Next
  18.     Next
  19. 'If Err <> 0 Then MsgBox "查不到結果": Exit Sub
  20. [c6] = brr(n, 1)
  21. MsgBox "最後有" & str & "為：" & brr(k, 1) & vbCr & "它的下一個是：" & brr(n, 1)
  22. End Sub
複製代碼
收藏 分享

GBKEE

帖子
5923 
主題
13 
精華
1 
積分
5986 
點名
0  
作業系統
win10 
軟體版本
Office 2010 
閱讀權限
150 
性別
男 
來自
台灣基隆 
註冊時間
2010-5-1 
最後登錄
2022-1-23 

2017 雞年全勤獎章2016猴年全勤獎章2015羊年全勤獎章2014馬年全勤獎章2013蛇年全勤獎章2012龍年全勤獎章論壇貢獻勳章熱烈參與勳章2011兔年全勤獎章
2#
發表於 2015-6-30 20:48 | 只看該作者
回復 1# starry1314
試試看
  1. Sub tt()
  2.     Dim arr(), str As String, brr As String
  3.     str = Sheets("工作表1").[c2].Value
  4.     Sheets("工作表1").[E8] = ""
  5.     arr = Sheets("data").[a1].CurrentRegion.Rows(2).Value
  6.     For i = 2 To UBound(arr, 2) Step 2
  7.             If InStr(arr(1, i), str) = 0 Then
  8.                 Sheets("工作表1").[E8] = arr(1, i - 1)
  9.                 brr = arr(1, i)
  10.                 Exit For
  11.             End If
  12.     Next
  13.     If brr = "" Then
  14.         MsgBox "查不到結果"
  15.     Else
  16.         MsgBox "最後有" & Sheets("工作表1").[E8] & "為：" & brr
  17.     End If
  18. End Sub
複製代碼
感恩的心......(在麻辣家族討論區.用心學習會有進步的)
但資源無限,後援有限,  一天1元的贊助,人人有能力.

TOP

starry1314
　暱稱: 豪

高中生Rank: 3Rank: 3

帖子
471 
主題
121 
精華
0 
積分
579 
點名
0  
作業系統
WIN10 
軟體版本
OFFICE2019 
閱讀權限
50 
性別
男 
註冊時間
2015-4-16 
最後登錄
2023-1-17 
3#
發表於 2015-6-30 22:38 | 只看該作者
本帖最後由 starry1314 於 2015-6-30 22:45 編輯

回復 2# GBKEE


    板大~不行耶,如果是單條件的話是正確的,
但如果C2為
EX:紅,糖  <不管輸入的條件是什麼只要是多條件他都會讀取第一項

目前寫法好像是把C2內容 視為一個條件,
正在找怎麼讓他以【,】做區分只要出現其中一個條件 就跳往下一道菜色

TOP

starry1314
　暱稱: 豪

高中生Rank: 3Rank: 3

帖子
471 
主題
121 
精華
0 
積分
579 
點名
0  
作業系統
WIN10 
軟體版本
OFFICE2019 
閱讀權限
50 
性別
男 
註冊時間
2015-4-16 
最後登錄
2023-1-17 
4#
發表於 2015-6-30 23:08 | 只看該作者
本帖最後由 starry1314 於 2015-6-30 23:13 編輯

回復 2# GBKEE


   有個想法...
如果以第一個條件搜尋完的結果位置,
再以第一個結果位置做為起始繼續以第二個條件繼續搜尋
直到C2的多條件皆搜尋過後的最後一筆+1=內容物皆無C2內條件的 菜

或是將C2的多條件不要做在同一個儲存格內,
EX C2有三個條件 牛,豬,羊
變更成
C2 牛
C3 豬
C4 羊

這樣會比較好嗎?

TOP

starry1314
　暱稱: 豪

高中生Rank: 3Rank: 3

帖子
471 
主題
121 
精華
0 
積分
579 
點名
0  
作業系統
WIN10 
軟體版本
OFFICE2019 
閱讀權限
50 
性別
男 
註冊時間
2015-4-16 
最後登錄
2023-1-17 
5#
發表於 2015-6-30 23:34 | 只看該作者
本帖最後由 starry1314 於 2015-6-30 23:39 編輯

回復 2# GBKEE
  1. Sub tt_GB1()

  3. 目前這樣可以達成我想要的多條件...但如果這樣使用str可能會達到上百個
  4. 有較簡易的寫法嗎??
  5. [code]Sub tt_GB1()
  6.     Dim arr(), str As String, brr As String, str1 As String, str2 As String
  7.     str = Sheets("工作表1").[c2].Value
  8.     str1 = Sheets("工作表1").[c3].Value
  9.     str2 = Sheets("工作表1").[c4].Value
  10.     'Sheets("工作表1").[E8] = ""
  11.     arr = Sheets("data").[a1].CurrentRegion.Rows(3).Value
  12.     For i = 2 To UBound(arr, 2) Step 2
  13.             If InStr(arr(1, i), str) = 0 Then
  14.             If InStr(arr(1, i), str1) = 0 Then
  15.             If InStr(arr(1, i), str2) = 0 Then
  16.                 Sheets("工作表1").[E8] = arr(1, i - 1)
  17.                 brr = arr(1, i)
  18.                 Exit For
  19.                 End If
  20.             End If
  21.             End If
  22.     Next
  23.     If brr = "" Then
  24.         MsgBox "查不到結果"
  25.     Else
  26.         MsgBox "最後有" & Sheets("工作表1").[E8] & "為：" & brr
  27.     End If
  28. End Sub
複製代碼

TOP

GBKEE

帖子
5923 
主題
13 
精華
1 
積分
5986 
點名
0  
作業系統
win10 
軟體版本
Office 2010 
閱讀權限
150 
性別
男 
來自
台灣基隆 
註冊時間
2010-5-1 
最後登錄
2022-1-23 

2017 雞年全勤獎章2016猴年全勤獎章2015羊年全勤獎章2014馬年全勤獎章2013蛇年全勤獎章2012龍年全勤獎章論壇貢獻勳章熱烈參與勳章2011兔年全勤獎章
6#
發表於 2015-7-1 06:01 | 只看該作者
回復 5# starry1314
正在找怎麼讓他以【,】做區分只要出現其中一個條件 就跳往下一道菜色
  1. Option Explicit
  2. Sub Ex()
  3.     Dim arr(), str As String, brr() As String, I As Integer
  4.     Dim S As Variant, E As Integer
  5.     str = Sheets("工作表1").[c2].Value
  6.     Sheets("工作表1").[E8] = ""
  7.     arr = Sheets("data").[a1].CurrentRegion.Rows(2).Value
  8.     For I = 2 To UBound(arr, 2) Step 2
  9.         S = Split(str, ",")
  10.         ReDim brr(0 To UBound(S))
  11.         For E = 0 To UBound(S)
  12.             If InStr(arr(1, I), S(E)) Then brr(E) = "禁忌"
  13.         Next
  14.         S = Join(brr, "")
  15.         If S = "" Then
  16.             Sheets("工作表1").[E8] = arr(1, I - 1)
  17.             Exit For
  18.         End If
  19.     Next
  20.     With Sheets("工作表1").[E8]
  21.         If .Value = "" Then
  22.             MsgBox "查不到結果"
  23.         Else
  24.             MsgBox "最後有 " & .Value & "為：" & arr(1, I)
  25.         End If
  26.     End With
  27. End Sub
複製代碼
感恩的心......(在麻辣家族討論區.用心學習會有進步的)
但資源無限,後援有限,  一天1元的贊助,人人有能力.

TOP

starry1314
　暱稱: 豪

高中生Rank: 3Rank: 3

帖子
471 
主題
121 
精華
0 
積分
579 
點名
0  
作業系統
WIN10 
軟體版本
OFFICE2019 
閱讀權限
50 
性別
男 
註冊時間
2015-4-16 
最後登錄
2023-1-17 
7#
發表於 2015-7-1 08:32 | 只看該作者
回復 6# GBKEE


    太感謝板大了~接下來就是廢時間的工程了..

因每格欄位要判斷的列數不同,只有部分是依序往下的,so要將近千個欄位一一套用此程式了

板大 可以幫我看看我註解的對嗎? 沒註明的是不太理解的部分
    Option Explicit '強制宣告 防止錯字 造成錯字誤以為變數
    Sub Ex()
        Dim arr(), str As String, brr() As String, I As Integer
        Dim S As Variant, E As Integer
        str = Sheets("工作表1").[c2].Value '讀取禁忌
        'Sheets("工作表1").[E8] = "" '將儲存格清空
        arr = Sheets("data").[a1].CurrentRegion.Rows(4).Value '讀取資料變數-列
        For I = 2 To UBound(arr, 2) Step 2 '資料變數 以2欄做為一個數據
            S = Split(str, ",") '將禁忌:以,區隔多條件
            ReDim brr(0 To UBound(S)) '數組內從0開始計算至最後一位 = 如 1-10 等同UBound 0-9
            For E = 0 To UBound(S)
                If InStr(arr(1, I), S(E)) Then brr(E) = "禁忌"
            Next
            S = Join(brr, "")
            If S = "" Then
                Sheets("工作表1").[E8] = arr(1, I - 1)
                Exit For
            End If
        Next
        With Sheets("工作表1").[E8]
            If .Value = "" Then
                MsgBox "查不到結果"
            Else
                MsgBox "最後有 " & .Value & "為：" & arr(1, I)
            End If
        End With
    End Sub

TOP

GBKEE

帖子
5923 
主題
13 
精華
1 
積分
5986 
點名
0  
作業系統
win10 
軟體版本
Office 2010 
閱讀權限
150 
性別
男 
來自
台灣基隆 
註冊時間
2010-5-1 
最後登錄
2022-1-23 

2017 雞年全勤獎章2016猴年全勤獎章2015羊年全勤獎章2014馬年全勤獎章2013蛇年全勤獎章2012龍年全勤獎章論壇貢獻勳章熱烈參與勳章2011兔年全勤獎章
8#
發表於 2015-7-1 15:49 | 只看該作者
回復 7# starry1314
  1. Option Explicit '強制宣告 防止變數Key錯字,造成錯字誤以為變數
  2.     Sub Ex()
  3.         Dim arr(), str As String, brr() As String, I As Integer
  4.         Dim S As Variant, E As Integer
  5.         str = Sheets("工作表1").[c2].Value '讀取禁忌
  6.         'Sheets("工作表1").[E8] = "" '將儲存格清空
  7.         arr = Sheets("data").[a1].CurrentRegion.Rows(4).Value '讀取資料變數-列
  8.         For I = 2 To UBound(arr, 2) Step 2 '資料變數 以2欄做為一個數據
  9.             S = Split(str, ",") '將禁忌:以,區隔多條件
  10.             ReDim brr(0 To UBound(S))
  11.             'ReDim 陳述式 在程序層次中用來重新配置動態陣列變數的儲存空間。
  12.             '數組內元素的上限值 '如 5-10 等同UBound=10 ,LBound=5 下限值
  13.             For E = 0 To UBound(S) '依序導入數組內元素
  14.                 If InStr(arr(1, I), S(E)) Then brr(E) = "禁忌"
  15.             Next
  16.             S = Join(brr, "")
  17.             'Join 函數 傳回一個字串 , 該字串是透過連結某個陣列中的多個子字串而建立的
  18.             If S = "" Then
  19.                 Sheets("工作表1").[E8] = arr(1, I - 1)
  20.                 Exit For
  21.             End If
  22.         Next
  23.         With Sheets("工作表1").[E8]
  24.             If .Value = "" Then
  25.                 MsgBox "查不到結果"
  26.             Else
  27.                 MsgBox "最後有 " & .Value & "為：" & arr(1, I)
  28.             End If
  29.         End With
  30.     End Sub
複製代碼
感恩的心......(在麻辣家族討論區.用心學習會有進步的)
但資源無限,後援有限,  一天1元的贊助,人人有能力.

TOP

starry1314
　暱稱: 豪

高中生Rank: 3Rank: 3

帖子
471 
主題
121 
精華
0 
積分
579 
點名
0  
作業系統
WIN10 
軟體版本
OFFICE2019 
閱讀權限
50 
性別
男 
註冊時間
2015-4-16 
最後登錄
2023-1-17 
9#
發表於 2015-7-1 17:11 | 只看該作者
回復 8# GBKEE


    感謝板大的教學！！！真是幫了大忙

TOP

starry1314
　暱稱: 豪

高中生Rank: 3Rank: 3

帖子
471 
主題
121 
精華
0 
積分
579 
點名
0  
作業系統
WIN10 
軟體版本
OFFICE2019 
閱讀權限
50 
性別
男 
註冊時間
2015-4-16 
最後登錄
2023-1-17 
10#
發表於 2015-7-17 08:57 | 只看該作者
回復 8# GBKEE

版大~請問FOR 和NEXT 是要在該怎麼放呢
我將原本的列,和要輸入的位置都改用變數,但我的 FOR A 只會跑第一次,之後的NEXT都不會再經過A,所以變成固定在第1列
A=列  Q=輸入位置
    Sub 跳禁忌()
    Dim arr(), str As String, brr() As String, I As Integer, A As Integer, Q As Integer
    Dim S As Variant, E As Integer

            str = Sheets("禁忌").[B3].Value
            For A = 1 To 100
            arr = Sheets("Data").[c1].CurrentRegion.Rows(A).Value
            
                For Q = 1 To 100
            
        
            For I = 2 To UBound(arr, 2) Step 2
                S = Split(str, ",")
                ReDim brr(0 To UBound(S))
                For E = 0 To UBound(S)
                    If InStr(arr(1, I), S(E)) Then brr(E) = "禁忌"
                Next
                S = Join(brr, "")
                If S = "" Then
                    Sheets("菜單").[C6] = arr(1, I - 1)
                    Exit For
                End If
            Next
            
            With Sheets("菜單").Range("c" & Q)
                If .Value = "" Then
                    'MsgBox "查不到結果"
                Else
                    'MsgBox "最後有 " & .Value & "為：" & arr(1, I)
                End If
            End With
        Next
    Next
End Sub

TOP

        靜思自在 : 【時間成就一切】時間可以造就人格，可以成就事業，也可以儲積功德。
12
返回列表 上一主題