麻辣家族討論版版 - Powered by Discuz! Board

標題: [發問] 關於此段程式碼的改進以及說明? [打印本頁]

作者: starry1314 時間: 2015-6-30 14:40 標題: 關於此段程式碼的改進以及說明?

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

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

Sub 避開禁忌()
Dim arr, str, i&, k&, n&, brr
On Error Resume Next
str = [c2].Value
arr = Sheets("data").[a1].CurrentRegion
ReDim brr(1 To UBound(arr) + 1, 1 To 2)
For i = 1 To UBound(arr)
For j = 1 To UBound(arr, 2) Step 2
If InStr(arr(i, j + 1), str) Then
k = k + 1
n = k + 1
brr(k, 1) = arr(i, j)
brr(k, 2) = arr(i, j + 1)
brr(n, 1) = arr(i, j + 2)
brr(n, 2) = arr(i, j + 3)
End If
Next
Next
'If Err <> 0 Then MsgBox "查不到結果": Exit Sub
[c6] = brr(n, 1)
MsgBox "最後有" & str & "為：" & brr(k, 1) & vbCr & "它的下一個是：" & brr(n, 1)
End Sub

複製代碼

作者: GBKEE 時間: 2015-6-30 20:48

回復 1# starry1314
試試看

Sub tt()
Dim arr(), str As String, brr As String
str = Sheets("工作表1").[c2].Value
Sheets("工作表1").[E8] = ""
arr = Sheets("data").[a1].CurrentRegion.Rows(2).Value
For i = 2 To UBound(arr, 2) Step 2
If InStr(arr(1, i), str) = 0 Then
Sheets("工作表1").[E8] = arr(1, i - 1)
brr = arr(1, i)
Exit For
End If
Next
If brr = "" Then
MsgBox "查不到結果"
Else
MsgBox "最後有" & Sheets("工作表1").[E8] & "為：" & brr
End If
End Sub

複製代碼

作者: starry1314 時間: 2015-6-30 22:38

本帖最後由 starry1314 於 2015-6-30 22:45 編輯

回復 2# GBKEE

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

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

作者: starry1314 時間: 2015-6-30 23:08

本帖最後由 starry1314 於 2015-6-30 23:13 編輯

回復 2# GBKEE

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

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

這樣會比較好嗎?

作者: starry1314 時間: 2015-6-30 23:34

本帖最後由 starry1314 於 2015-6-30 23:39 編輯

回復 2# GBKEE

Sub tt_GB1()
目前這樣可以達成我想要的多條件...但如果這樣使用str可能會達到上百個
有較簡易的寫法嗎??
[code]Sub tt_GB1()
Dim arr(), str As String, brr As String, str1 As String, str2 As String
str = Sheets("工作表1").[c2].Value
str1 = Sheets("工作表1").[c3].Value
str2 = Sheets("工作表1").[c4].Value
'Sheets("工作表1").[E8] = ""
arr = Sheets("data").[a1].CurrentRegion.Rows(3).Value
For i = 2 To UBound(arr, 2) Step 2
If InStr(arr(1, i), str) = 0 Then
If InStr(arr(1, i), str1) = 0 Then
If InStr(arr(1, i), str2) = 0 Then
Sheets("工作表1").[E8] = arr(1, i - 1)
brr = arr(1, i)
Exit For
End If
End If
End If
Next
If brr = "" Then
MsgBox "查不到結果"
Else
MsgBox "最後有" & Sheets("工作表1").[E8] & "為：" & brr
End If
End Sub

複製代碼

作者: GBKEE 時間: 2015-7-1 06:01

回復 5# starry1314

正在找怎麼讓他以【,】做區分只要出現其中一個條件就跳往下一道菜色

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(2).Value
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("工作表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

複製代碼

作者: starry1314 時間: 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

作者: GBKEE 時間: 2015-7-1 15:49

回復 7# starry1314

Option Explicit '強制宣告防止變數Key錯字,造成錯字誤以為變數
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))
'ReDim 陳述式在程序層次中用來重新配置動態陣列變數的儲存空間。
'數組內元素的上限值 '如 5-10 等同UBound=10 ,LBound=5 下限值
For E = 0 To UBound(S) '依序導入數組內元素
If InStr(arr(1, I), S(E)) Then brr(E) = "禁忌"
Next
S = Join(brr, "")
'Join 函數傳回一個字串 , 該字串是透過連結某個陣列中的多個子字串而建立的
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

複製代碼

作者: starry1314 時間: 2015-7-1 17:11

回復 8# GBKEE

感謝板大的教學！！！真是幫了大忙
作者: starry1314 時間: 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
作者: starry1314 時間: 2015-7-17 13:32

回復 8# GBKEE

已附上檔案~再請版大幫忙看看
[attach]21406[/attach]
作者: starry1314 時間: 2015-7-17 17:30

回復 2# GBKEE

突然想到..
用同一個變數即可..不用用到A與Q ,目前已解決~但這方式好像速度慢很多
之前版大提供的方式,一個一個位置去設定速度快上很多！雖然眼都快瞎了。。。
  Sub 跳禁忌()

Dim arr(), str As String, brr() As String, I As Integer, A As Integer

Dim S As Variant, E As Integer

         str = Sheets("快速輸入").[B3].Value

         For A = 1 To 1000

         arr = Sheets("菜單(勿動)").[c1].CurrentRegion.Rows(A).Value







         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("工作表2").Range("B" & A) = arr(1, I - 1)

                  Exit For

            End If

         Next



         With Sheets("工作表2").Range("B" & A)

            If .Value = "" Then

                  'MsgBox "查不到結果"

            Else

                  'MsgBox "最後有 " & .Value & "為：" & arr(1, I)

            End If

         End With

      Next

End Sub
複製代碼

歡迎光臨麻辣家族討論版版 (http://forum.twbts.com/)