12
返回列表 上一主題 發帖

程式如何寫比較順暢快速

myleoyes

帖子
463 
主題
116 
精華
0 
積分
580 
點名
0  
作業系統
Vista 
軟體版本
2007 
閱讀權限
50 
性別
男 
註冊時間
2010-5-4 
最後登錄
2017-11-13 

論壇贊助勳章論壇榮譽勳章
1# 跳轉到 » 正序看帖
打印
tT
發表於 2012-10-24 22:40 | 只看該作者

程式如何寫比較順暢快速

各位前輩你們好!
         前輩!!問題如附檔說明
         請知道的前輩,不吝賜教謝謝再三!!
Sub 練習()
    With Sheets("練習")
      [AG3] = "=AB2-SUM(AD2/2,AE2,AA3,AC3/2)": [AI3] = "=AG3/(AA3+AC3/2)"
      .Range("V" & Rows.Count).End(xlUp)(2, 1).Select: Selection = Date: ActiveCell.Offset(0, 1).Select
      ZZ = Application.InputBox("請輸入數字", "練習資料", Type:=1)
      If ZZ <= 0 Then ActiveCell.Offset(0, -1) = "": [AG3,AI3] = "": End
      ActiveCell = ZZ: ActiveCell.Font.ColorIndex = 7: ActiveCell.Offset(0, 1).Select
ag:
      ZZ = Application.InputBox("請輸入數字", "數據資料", Type:=1)
      If ZZ <= 0 Then GoTo ag
      ActiveCell = ZZ: ActiveCell.Offset(0, 2).Select
      [Z3:AI3].Copy: ActiveSheet.Paste: Calculate: [AG3,AI3] = "": Application.CutCopyMode = False
      ActiveCell.Offset(, 2) = "": ActiveCell.Offset(, 4) = "": ActiveCell.Offset(, 5) = "": ActiveCell.Offset(, 8) = ""
      .Range("AC" & Rows.Count).End(xlUp).Select
      If Selection <= 150 Then Selection = 200: ActiveCell.Font.ColorIndex = 7
      .Range("AG" & Rows.Count).End(xlUp).Select: ActiveCell.Font.ColorIndex = 10
      .Range("AI" & Rows.Count).End(xlUp).Select
      If Selection < 0 Then ActiveCell.Font.ColorIndex = 3
: Calculate: .Columns("V:AI").EntireColumn.AutoFit
      End With
      ActiveWorkbook.Save
End Sub

LeoV66.rar (10.87 KB)

收藏 分享

myleoyes

帖子
463 
主題
116 
精華
0 
積分
580 
點名
0  
作業系統
Vista 
軟體版本
2007 
閱讀權限
50 
性別
男 
註冊時間
2010-5-4 
最後登錄
2017-11-13 

論壇贊助勳章論壇榮譽勳章
19#
發表於 2012-10-30 21:11 | 只看該作者
回復 18# GBKEE
良師!太感動囉!真的感恩...太厲害謝謝再三!!辛苦囉!!

TOP

GBKEE

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

2017 雞年全勤獎章2016猴年全勤獎章2015羊年全勤獎章2014馬年全勤獎章2013蛇年全勤獎章2012龍年全勤獎章論壇貢獻勳章熱烈參與勳章2011兔年全勤獎章
18#
發表於 2012-10-30 10:25 | 只看該作者
回復 17# myleoyes
你的想法是 :
登入可以指定多個B欄的數值,後執行寫入程式
  1. Sub Ex()
  2.     Dim Rng As Range, ZZ As Range, A As String, Msg As Boolean
  3.     With Sheets("學習")
  4.         Set Rng = .Range("b3", .[b3].End(xlDown))                  'B欄的範圍
  5.         For Each ZZ In Selection                                   '工作表:所選取儲存格的範圍
  6.             If Not Application.Intersect(Rng, ZZ) Is Nothing Then  '判斷此物件代表兩個或多個範圍重疊的矩形範圍
  7.                 Msg = True
  8.                 A = IIf(A = "", ZZ.Address(0, 0), A & "," & ZZ.Address(0, 0))
  9.             End If
  10.         Next
  11.         If Msg = False Then
  12.             MsgBox "沒有選擇到B欄的數值...": Exit Sub
  13.         Else
  14.             If MsgBox("所選取資料 " & A & Chr(10) & "確定 寫入 ...", vbYesNo) = vbNo Then Exit Sub
  15.         End If
  16.         For Each ZZ In Selection
  17.             If Not Application.Intersect(Rng, ZZ) Is Nothing Then
  18.                 With .Range("N" & Rows.Count).End(xlUp)
  19.                     .Cells(2, 1) = ZZ
  20.                     .Cells(2, 2) = ZZ.Cells(1, 2)
  21.                 End With
  22.             End If
  23.         Next
  24.     End With
  25.     寫入
  26. End Sub
複製代碼

TOP

myleoyes

帖子
463 
主題
116 
精華
0 
積分
580 
點名
0  
作業系統
Vista 
軟體版本
2007 
閱讀權限
50 
性別
男 
註冊時間
2010-5-4 
最後登錄
2017-11-13 

論壇贊助勳章論壇榮譽勳章
17#
發表於 2012-10-29 22:29 | 只看該作者
回復 16# GBKEE
良師!小弟又把你給弄迷糊歹勢啦!
    本範例程式分為2部份
    1,登入就是將B欄與C欄資料登入在N欄所指定的位置
    2,寫入就是將N3:U4複製到B欄與C欄資料登入在N欄所指定的位置
      登入可單選與複選兩種
      原程式登入
    ag:
      ZZ = Application.InputBox("請在B欄中選取資料", "資料登入", Type:=2)
      因為Type:=2 所以If ZZ = "" Then Selection = "": End  程式接受
                  If ZZ = False Then  Selection = "": End  程式接受
                  If 選取並非B欄資料  Then MsgBox "選取的資料並非B欄所有！！請重新選取": GoTo ag
      也就是說當第一次按登入鈕是可以後悔的,所以選擇取消或空白來結束程式
      若選取B欄確定,程式將B欄與C欄資料登錄在N欄所指定的位置
      程式再次呼叫下面的對話框
    ag1:
      ZZ = Application.InputBox("請在B欄中選取資料", "資料登入", Type:=1)
      因為Type:=1 所以If ZZ = "" Then 程式不接受
                  If 選取並非B欄資料  Then MsgBox "選取的資料並非B欄所有！！請重新選取": GoTo ag1
                  如果選擇取消If ZZ = False Then 寫入: End
                  呼叫寫入程式就完成所需的任務這就是單選登入
                  若選取B欄確定,程式將B欄與C欄資料登錄在N欄所指定的位置
                  因為GoTo ag1所以Type:=1的對話框可以重複的出現一直到
                  選擇取消If ZZ = False Then 寫入: End
                  呼叫寫入程式就完成所需的任務這就是複選登入
      然而對話框Type:=1或Type:=2都無法達成"選擇必需是 ""B"" 欄"之要求
      良師為了達成"選擇必需是 ""B"" 欄"之要求將登入程式改為
      Set ZZ = Application.InputBox("請在B欄中選取資料", "資料登入", Type:=8)
      ....
      On Error GoTo 0
      End Sub
      因為Type:=8 所以If ZZ = False Then  程式不接受
                  若選取B欄確定,程式將B欄與C欄資料登錄在N欄所指定的位置
                  程式到此為止,並沒有呼叫寫入程式就無法完成所需的任務
                  所以必須再按寫入鈕才能完成所需的任務,這樣太麻煩!!
                  程式可以登入但無法寫入(也就是說沒有自動)這句話的由來
                  即便加入寫入程式也是單選登入的功能罷!!
      所以小弟加入 If MsgBox("請問你是否繼續選取資料！！", vbYesNo) = vbYes Then
           登入
      ElseIf vbNo Then 寫入
      End If
      以提示對話框解決複選與寫入的問題
      假如按登入10次就必需也按提示對話框10次
      所以覺得以良師的功力應該是可以省略這個提示對話框
      就可以完成所需的任務不是嗎?
      這就是小弟的概念...不善表達,長篇大論不知良師!
      是否了解..真不好意思謝謝再三!!

TOP

GBKEE

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

2017 雞年全勤獎章2016猴年全勤獎章2015羊年全勤獎章2014馬年全勤獎章2013蛇年全勤獎章2012龍年全勤獎章論壇貢獻勳章熱烈參與勳章2011兔年全勤獎章
16#
發表於 2012-10-29 07:11 | 只看該作者
回復 15# myleoyes
程式可以登入但無法寫入(也就是說沒有自動)
   小弟修改如下只是覺得提示對話框是可以省略

要寫入什麼,這概念我一點都不了解,要如何省略對話框?

TOP

myleoyes

帖子
463 
主題
116 
精華
0 
積分
580 
點名
0  
作業系統
Vista 
軟體版本
2007 
閱讀權限
50 
性別
男 
註冊時間
2010-5-4 
最後登錄
2017-11-13 

論壇贊助勳章論壇榮譽勳章
15#
發表於 2012-10-28 22:54 | 只看該作者
回復 14# GBKEE
良師!謝謝!程式可以登入但無法寫入(也就是說沒有自動)
        小弟修改如下只是覺得提示對話框是可以省略
         以便加速處理資料不是嗎?僅供參考真的辛苦你囉!
         非常的感恩謝謝再三!!

Leov68-1.gif (620.12 KB)

Leov68-1.gif

LeoV68-1.rar (15.02 KB)

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#
發表於 2012-10-28 20:45 | 只看該作者
回復 13# myleoyes
試試看
  1. Sub 登入()
  2.     Dim ZZ As Range
  3.     On Error GoTo er:
  4.     With Sheets("學習")
  5.         Do
  6.             Set ZZ = Application.InputBox("請在B欄中選取資料", "資料登入", Type:=8)
  7.             'InputBox 設為Range ->    按 取消 會有錯誤
  8.             If ZZ(1).Column <> 2 Then xMsg = "選擇必需是 ""B"" 欄"
  9.         Loop Until ZZ(1).Column = 2               'B欄
  10.         With .Range("N" & Rows.Count).End(xlUp)
  11.             .Cells(2, 1) = ZZ(1)                 '預防ZZ選多列,指定為ZZ的CELLS(1)
  12.             .Cells(2, 2) = ZZ.Cells(1, 2)
  13.         End With
  14.     End With
  15. er:
  16.     Err.Clear
  17.     On Error GoTo 0
  18. End Sub
複製代碼

TOP

myleoyes

帖子
463 
主題
116 
精華
0 
積分
580 
點名
0  
作業系統
Vista 
軟體版本
2007 
閱讀權限
50 
性別
男 
註冊時間
2010-5-4 
最後登錄
2017-11-13 

論壇贊助勳章論壇榮譽勳章
13#
發表於 2012-10-28 16:16 | 只看該作者
回復 8# GBKEE
前輩!非常謝謝指導...
良師!謝謝!原來如此!殆勢啦!又來一題
照你的指導畫葫蘆還是畫不出來
登入程式實在沒辦法
寫入程式勉強可以執行
執行結果如動畫所示
請再指導真的感恩謝謝再三!!
Sub 登入()
    With Sheets("學習")
ag:
       ZZ = Application.InputBox("請在B欄中選取資料", "資料登入", Type:=2)
       If ZZ = "" Then Selection = "": End
       If ZZ = False Then Selection = "": End
       .Range("N" & Rows.Count).End(xlUp)(2, 1).Select
       ActiveCell = ZZ: ActiveCell.Offset(0, 1) = [C5]
      ' 如果選取並非B欄資料  Then MsgBox "選取的資料並非B欄所有！！請重新選取": GoTo ag
ag1:
       ZZ = Application.InputBox("請在B欄中選取資料", "資料登入", Type:=1)
       If ZZ = False Then 寫入: End
       .Range("N" & Rows.Count).End(xlUp)(2, 1).Select
       ActiveCell = ZZ: ActiveCell.Offset(0, 1) = [C7]
       ' 如果選取並非B欄資料  Then MsgBox "選取的資料並非B欄所有！！請重新選取": GoTo ag1
       GoTo ag1
    End With
End Sub
Sub 寫入()
    Dim Rng As Range
ag:
    With Sheets("學習")
    Set Rng = Sheets("學習").Range("U" & Rows.Count).End(xlUp)(2, 1)
       ZZ = Application.InputBox("請輸入數字", "數字", Type:=1)
       If ZZ <= 0 Then GoTo ag
        With Rng.Cells(1, -4)
            .Value = ZZ
            .NumberFormatLocal = "#,##0_ ;[紅色]-#,##0 "
            .Font.ColorIndex = 10
        End With
     End With
      With Sheets("學習")
      Set Rng = Sheets("學習").Range("N" & Rows.Count).End(xlUp)(1, 1)
      With Rng.Cells(1, 1)
            For Each R In Array(8)
                With .Cells(1, R)
                    .FormulaR1C1 = Cells(3, .Column).FormulaR1C1
                    If R = 8 Then
                        .Font.ColorIndex = 7
                        .NumberFormatLocal = "0.00%"
                    End If
                End With
                Next
            End With
    Set Rng = Sheets("學習").Range("N" & Rows.Count).End(xlUp)(2, 1)
      With Rng.Cells(1, 1)
            For Each e In Array(1, 2, 3, 4, 5, 6, 8)
                With .Cells(1, e)
                    .FormulaR1C1 = Cells(4, .Column).FormulaR1C1
                    If e = 1 Then
                        .Font.ColorIndex = 1
                    ElseIf e = 3 Then
                        .Value = Date
                        .NumberFormat = "e/m/d"
                        .Font.ColorIndex = 5
                    ElseIf e = 8 Then
                        .Value = Date
                        .NumberFormatLocal = "#,##0_ ;[紅色]-#,##0 "
                    End If
                End With
            Next
        End With
    With Sheets("學習")
    Set Rng = Sheets("學習").Range("N" & Rows.Count).End(xlUp)(1, 1)
        ZZ = Application.InputBox("請輸入數據", "數據", Type:=1)
          If ZZ <= 0 Then Exit Sub
            With Rng.Cells(1, 7)
              .Value = ZZ
            End With
        End With
       .Columns("N:U").EntireColumn.AutoFit
    End With
End Sub

Leov68.gif (502.14 KB)

Leov68.gif

LeoV68.rar (14.12 KB)

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#
發表於 2012-10-28 09:17 | 只看該作者
回復 10# c_c_lai
看看工作表它的公式
  1. Sub Ex()
  2.     [B5] = "=R[1]C[1]"
  3.     [B6] = "=C6"
  4.     [B7] = "=R[-1]C[1]"
  5.     [B8] = "=R6C3"
  6.     [B9] = "=$C$6"
  7. End Sub
複製代碼

TOP

c_c_lai

帖子
2035 
主題
24 
精華
0 
積分
2031 
點名
0  
作業系統
Win7 
軟體版本
Office2010 
閱讀權限
100 
性別
男 
註冊時間
2012-3-22 
最後登錄
2024-2-1 
11#
發表於 2012-10-28 08:34 | 只看該作者
回復 8# GBKEE
補上檔案共參考：
LeoV67.rar (9.62 KB)

TOP

        靜思自在 : 人生沒有所有權，只有生命的使用權。
12
返回列表 上一主題