12
返回列表 上一主題 發帖

[發問] ~ 發現一個新的問題 關於IF判斷式

GBKEE

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

2017 雞年全勤獎章2016猴年全勤獎章2015羊年全勤獎章2014馬年全勤獎章2013蛇年全勤獎章2012龍年全勤獎章論壇貢獻勳章熱烈參與勳章2011兔年全勤獎章
11# 跳轉到 »
發表於 2014-4-11 17:25 | 顯示全部帖子
回復 28# willy1205
  1. Option Explicit
  2. Sub RoundedRectangle1_Click()
  3.     Dim NewRow As Integer, E As Range, Sh As Worksheet
  4.     Set Sh = Worksheets("Sheet1")  '變數指定為工作表 **下面的程式碼如有更改 工作表 **改這變數可省麻煩
  5.    'Worksheets("sheet1").Range("B8").Value  '管他是 甲君,乙君,丙君 只要這工作表(名稱)有在活頁簿中,
  6.     For Each E In Sh.Range("B8,B10")  '導入B8,B10 的儲存格
  7.         '判斷 主辦,協辦 的列號
  8.         If E.Address = "$B$8" Then   '主辦
  9.             NewRow = Sh.Range("J34").Value
  10.         Else                         '協辦
  11.             NewRow = Sh.Range("J35").Value
  12.         End If
  13.         
  14.         With Worksheets(E.Value)   'E.Value 的工作表
  15.             .Cells(NewRow, 1) = Sh.Range("C5")
  16.             .Cells(NewRow, 2) = Sh.Range("C6").Value
  17.             .Cells(NewRow, 3) = Sh.Range("I12").Value
  18.             .Cells(NewRow, 4) = Sh.Range("I13").Value
  19.             .Cells(NewRow, 6) = Sh.Range("G22").Value
  20.             '判斷主辦,協辦 要改變的位置列號
  21.             If E.Address = "$B$8" Then   '主辦
  22.                 .Cells(NewRow, 7) = Sh.Range("H30")
  23.             Else                          '協辦
  24.                 .Cells(NewRow, 7) = Sh.Range("H32")
  25.             End If
  26.         End With
  27.     Next
  28.     MsgBox "New Data added", vbOKOnly, "Data"
  29. End Sub
複製代碼
感恩的心......(在麻辣家族討論區.用心學習會有進步的)
但資源無限,後援有限,  一天1元的贊助,人人有能力.

TOP

GBKEE

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

2017 雞年全勤獎章2016猴年全勤獎章2015羊年全勤獎章2014馬年全勤獎章2013蛇年全勤獎章2012龍年全勤獎章論壇貢獻勳章熱烈參與勳章2011兔年全勤獎章
12#
發表於 2014-5-21 15:29 | 顯示全部帖子
回復 35# willy1205
  1. Sub Ex()
  2. Dim E, NewRow
  3. For Each E In Range("B8,B10,C10,C12")
  4.     Select Case E.Address(0, 0)
  5.     Case "B8"
  6.         NewRow = 1
  7.     Case "B10"
  8.         NewRow = 2
  9.     Case "C10"
  10.         NewRow = 3
  11.     Case "C12"
  12.         NewRow = 4
  13.     End Select

  15.     MsgBox NewRow
  16. Next
  17. End Sub
  18. Sub Ex1()
  19. Dim E, NewRow
  20. For Each E In Range("B8,B10,C10,C12")
  21.     If E.Address(0, 0) = "B8" Then
  22.         NewRow = 1
  23.     ElseIf E.Address(0, 0) = "B10" Then
  24.         NewRow = 2
  25.     ElseIf E.Address(0, 0) = "C10" Then
  26.         NewRow = 3
  27.     ElseIf E.Address(0, 0) = "C12" Then
  28.         NewRow = 4
  29.     End If
  30.     MsgBox NewRow
  31. Next
  32. End Sub
複製代碼
感恩的心......(在麻辣家族討論區.用心學習會有進步的)
但資源無限,後援有限,  一天1元的贊助,人人有能力.

TOP

GBKEE

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

2017 雞年全勤獎章2016猴年全勤獎章2015羊年全勤獎章2014馬年全勤獎章2013蛇年全勤獎章2012龍年全勤獎章論壇貢獻勳章熱烈參與勳章2011兔年全勤獎章
13#
發表於 2014-5-28 14:54 | 顯示全部帖子
回復 40# willy1205
你回復的是willy1205 我沒查看到
  1. Sub Allowance報銷單_RoundedRectangle2_Click()
  2. Dim NewRow As Integer, E As Range, Sh As Worksheet
  3.     Set Sh = Worksheets("4-工作日誌OP COA AGR")
  4.     For Each E In Range("B10,B12,C10,C12")
  5.         If E <> "" Then  '
  6.             Select Case E.Address(0, 0)
  7.                 Case "B10"
  8.                     NewRow = 1
  9.                 Case "B12"
  10.                     NewRow = 2
  11.                 Case "C10"
  12.                     NewRow = 3
  13.                 Case "C12"
  14.                     NewRow = 4
  15.             End Select
  16.             With Worksheets(E.Value)
  17.             'E = "" 或沒這工作表-> out of range 陣列索引超出範圍 (錯誤 9)
  18.                 .Cells(NewRow, 1) = Sh.Range("C7")
  19.                 .Cells(NewRow, 2) = Sh.Range("C8").Value
  20.                 .Cells(NewRow, 3) = Sh.Range("I14").Value
  21.                 .Cells(NewRow, 4) = Sh.Range("I15").Value
  22.                 .Cells(NewRow, 6) = Sh.Range("G24").Value
  23.                 If E.Address = "$B$10" Then
  24.                     .Cells(NewRow, 7) = Sh.Range("H32")
  25.                     .Cells(NewRow, 5) = Sh.Range("J10").Value
  26.                     Sh.Range("J34") = NewRow
  27.                 Else
  28.                     .Cells(NewRow, 7) = Sh.Range("H34")
  29.                     .Cells(NewRow, 5) = Sh.Range("J12").Value
  30.                     Sh.Range("J35") = NewRow
  31.                 End If
  32.             End With
  33.         End If
  34.     Next
  35.     MsgBox "New Data added", vbOKOnly, "Data"
  36. End Sub
複製代碼
感恩的心......(在麻辣家族討論區.用心學習會有進步的)
但資源無限,後援有限,  一天1元的贊助,人人有能力.

TOP

GBKEE

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

2017 雞年全勤獎章2016猴年全勤獎章2015羊年全勤獎章2014馬年全勤獎章2013蛇年全勤獎章2012龍年全勤獎章論壇貢獻勳章熱烈參與勳章2011兔年全勤獎章
14#
發表於 2014-5-31 20:25 | 顯示全部帖子
回復 42# willy1205
就是B10與C10他們導出的結果是一樣，然後B12與C12導出的結果一樣

你要的導出的結果,請附檔看看.猜不出你要的是什麼!!是這樣嗎?
  1. Sub Allowance報銷單_RoundedRectangle2_Click()
  2. Dim NewRow As Integer, E As Range, Sh As Worksheet
  3.     Set Sh = Worksheets("4-工作日誌OP COA AGR")
  4.     For Each E In Range("B10,B12")
  5.         If E <> "" Then
  6.             Set Sh = Sheets(E.Value)
  7.         Else
  8.             Set Sh = Sheets(E.Offset(, 1).Value)
  9.         End If
  10.         If E.Address(0, 0) = "B10" Then NewRow = 1
  11.         If E.Address(0, 0) = "B12" Then NewRow = 2
  12.         With Sh
  13.             .Cells(NewRow, 1) = .Range("C7")
  14.             .Cells(NewRow, 2) = .Range("C8").Value
  15.             .Cells(NewRow, 3) = .Range("I14").Value
  16.             .Cells(NewRow, 4) = .Range("I15").Value
  17.             .Cells(NewRow, 6) = .Range("G24").Value
  18.             If E.Address = "$B$10" Then
  19.                 .Cells(NewRow, 7) = .Range("H32")
  20.                 .Cells(NewRow, 5) = .Range("J10").Value
  21.                 .Range("J34") = NewRow
  22.             Else
  23.                 .Cells(NewRow, 7) = .Range("H34")
  24.                 .Cells(NewRow, 5) = .Range("J12").Value
  25.                 .Range("J35") = NewRow
  26.             End If
  27.         End With
  28.         End If
  29.     Next
  30.     MsgBox "New Data added", vbOKOnly, "Data"
  31. End Sub
複製代碼
感恩的心......(在麻辣家族討論區.用心學習會有進步的)
但資源無限,後援有限,  一天1元的贊助,人人有能力.

TOP

GBKEE

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

2017 雞年全勤獎章2016猴年全勤獎章2015羊年全勤獎章2014馬年全勤獎章2013蛇年全勤獎章2012龍年全勤獎章論壇貢獻勳章熱烈參與勳章2011兔年全勤獎章
15#
發表於 2014-6-5 13:30 | 顯示全部帖子
回復 44# willy1205
試試看
  1. Sub Allowance報銷單_RoundedRectangle2_Click()
  2.     Dim NewRow As Integer, E As Range, Sh As Worksheet
  3.     Dim Rng(1 To 2) As Range, i As Integer
  4.     Set Sh = Worksheets("4-工作日誌OP COA AGR")
  5.     With Sh
  6.         Set Rng(1) = .Range("b10:F10") '主辦者的儲存格範圍
  7.         Set Rng(2) = .Range("b12:F12") '協辦者的儲存格範圍
  8.     End With
  9.     For i = 1 To 2
  10.         NewRow = Sh.Range("J34").Value
  11.         If i = 2 Then NewRow = Sh.Range("J35").Value
  12.         For Each E In Rng(i)
  13.             If E <> "" Then
  14.                 With Worksheets(E.Value)
  15.                     .Cells(NewRow, 1) = Sh.Range("C7")
  16.                     .Cells(NewRow, 2) = Sh.Range("C8").Value
  17.                     .Cells(NewRow, 3) = Sh.Range("I14").Value
  18.                     .Cells(NewRow, 4) = Sh.Range("I15").Value
  19.                     .Cells(NewRow, 6) = Sh.Range("G24").Value
  20.                     If i = 1 Then
  21.                         .Cells(NewRow, 7) = Sh.Range("H32")
  22.                         .Cells(NewRow, 5) = Sh.Range("J10").Value
  23.                         Sh.Range("J34") = NewRow
  24.                     Else
  25.                         .Cells(NewRow, 7) = Sh.Range("H34")
  26.                         .Cells(NewRow, 5) = Sh.Range("J12").Value
  27.                         Sh.Range("J35") = NewRow
  28.                     End If
  29.                 End With
  30.             End If
  31.         Next
  32.     Next
  33.     MsgBox "New Data added", vbOKOnly, "Data"
  34. End Sub
複製代碼
感恩的心......(在麻辣家族討論區.用心學習會有進步的)
但資源無限,後援有限,  一天1元的贊助,人人有能力.

TOP

        靜思自在 : 能付出愛心就是福，能消除煩惱就是慧。
12
返回列表 上一主題