程式如何寫比較順暢快速

c_c_lai

博士班 Rank: 6 Rank: 6

帖子: 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

GBKEE

超級版主 Rank: 8 Rank: 8

帖子: 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
看看工作表它的公式

Sub Ex()
[B5] = "=R[1]C[1]"
[B6] = "=C6"
[B7] = "=R[-1]C[1]"
[B8] = "=R6C3"
[B9] = "=$C$6"
End Sub

複製代碼

TOP

myleoyes

高中生 Rank: 3 Rank: 3

帖子: 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.rar (14.12 KB)

TOP

GBKEE

超級版主 Rank: 8 Rank: 8

帖子: 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
試試看

Sub 登入()
Dim ZZ As Range
On Error GoTo er:
With Sheets("學習")
Do
Set ZZ = Application.InputBox("請在B欄中選取資料", "資料登入", Type:=8)
'InputBox 設為Range -> 按取消會有錯誤
If ZZ(1).Column <> 2 Then xMsg = "選擇必需是 ""B"" 欄"
Loop Until ZZ(1).Column = 2 'B欄
With .Range("N" & Rows.Count).End(xlUp)
.Cells(2, 1) = ZZ(1) '預防ZZ選多列,指定為ZZ的CELLS(1)
.Cells(2, 2) = ZZ.Cells(1, 2)
End With
End With
er:
Err.Clear
On Error GoTo 0
End Sub

複製代碼

TOP

myleoyes

高中生 Rank: 3 Rank: 3

帖子: 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.rar (15.02 KB)

TOP

GBKEE

超級版主 Rank: 8 Rank: 8

帖子: 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

高中生 Rank: 3 Rank: 3

帖子: 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