麻辣家族討論版版 » Excel程式區 » 改變來源檔

返回列表下一主題上一主題發帖

改變來源檔

高中生 Rank: 3 Rank: 3

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

論壇贊助勳章論壇榮譽勳章

1^# 跳轉到 » 正序看帖

字體大小: tT

發表於 2013-9-28 22:22 | 只看該作者

改變來源檔

各位前輩你們好!!
問題如附檔說明
請知道的前輩,不吝賜教謝謝再三!!

LeoV75.rar (114.08 KB)

樓主熱帖

收藏

高中生 Rank: 3 Rank: 3

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

論壇贊助勳章論壇榮譽勳章

10^#

發表於 2013-10-3 21:07 | 只看該作者

回復 9# 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兔年全勤獎章

9^#

發表於 2013-10-2 14:59 | 只看該作者

回復 8# myleoyes
改成如此

Sub 尋找()
Dim Rng As Range, E As Range, Msg As Boolean
With Sheet2.Range("D:D")
If Not IsError(Application.Match(Sheet6.[E1], .Cells, 0)) Then
Application.EnableEvents = False
.Replace Sheet6.[E1], "=XXX", xlWhole
Set Rng = .SpecialCells(xlCellTypeFormulas, xlErrors)
Rng.Cells = Sheet6.[E1]
For Each E In Rng.Offset(, 3)
If E = Sheet6.[F1] And E.Offset(, 2) = Sheet6.[G1] Then
E.Offset(, -2).Select
Msg = True
Exit For
End If
Next
If Msg = False Then Rng(Rng.Rows.Count, 2).Select
Application.EnableEvents = True
Else
.Parent.Range("A" & .Parent.Rows.Count).End(xlUp)(0, 1).Offset(1).Select
End If
End With
End Sub

複製代碼

感恩的心......(在麻辣家族討論區.用心學習會有進步的)
但資源無限,後援有限, 一天1元的贊助,人人有能力.

高中生 Rank: 3 Rank: 3

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

論壇贊助勳章論壇榮譽勳章

8^#

發表於 2013-10-1 21:43 | 只看該作者

回復 6# GBKEE
良師!
   程式凸槌如附檔說明
   請再麻煩修改辛苦囉!謝謝再三!!

LeoV76-2.rar (212.91 KB)

高中生 Rank: 3 Rank: 3

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

論壇贊助勳章論壇榮譽勳章

7^#

發表於 2013-9-30 21:52 | 只看該作者

回復 6# 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兔年全勤獎章

6^#

發表於 2013-9-30 09:02 | 只看該作者

回復 5# myleoyes

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Select Case Target(1).Address(0, 0)
Case "A1"
ActiveWindow.ScrollColumn = 1
End Select
With Target(1)
If .Column = 1 Then
If (.Row >= 3 And .Row <= 12) And Target(1) <> "" Then '**********
插入刪除
End If
End If
End With
End Sub

複製代碼

或是如此

Sub 尋找()
Dim Rng As Range, F1, F2
With Sheet2.Range("D:D")
If Not IsError(Application.Match(Sheet6.[E1], .Cells, 0)) Then
Application.EnableEvents = False '*************
.Replace Sheet6.[E1], "=XXX", xlWhole
Set Rng = .SpecialCells(xlCellTypeFormulas, xlErrors)
Rng.Cells = Sheet6.[E1]
F1 = Application.Match(Sheet6.[F1], Rng.Offset(, 3), 0)
F2 = Application.Match(Sheet6.[G1], Rng.Offset(, 5), 0)
If Not IsError(F1) And Not IsError(F2) Then
If F1 = F2 Then Rng(F1, 2).Select
If F1 <> F2 Then Rng(Rng.Rows.Count, 2).Select
Else
Rng(Rng.Rows.Count, 2).Select
End If
Application.EnableEvents = True ''*************
Else
.Parent.Range("A" & .Parent.Rows.Count).End(xlUp).Offset(1).Select
End If
End With
End Sub

複製代碼

感恩的心......(在麻辣家族討論區.用心學習會有進步的)
但資源無限,後援有限, 一天1元的贊助,人人有能力.

高中生 Rank: 3 Rank: 3

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

論壇贊助勳章論壇榮譽勳章

5^#

發表於 2013-9-29 20:34 | 只看該作者

回復 4# GBKEE
良師!
程式程序都對,但是小弟加入程式後
卻無法執行出現錯誤
如附檔所示請再麻煩修改
辛苦囉!謝謝再三!!

LeoV76-1.rar (105.13 KB)

超級版主 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兔年全勤獎章

4^#

發表於 2013-9-29 16:40 | 只看該作者

回復 3# myleoyes

Sub 尋找()
Dim Rng As Range, F1, F2
With Sheet2.Range("D:D")
If Not IsError(Application.Match(Sheet6.[E1], .Cells, 0)) Then
.Replace Sheet6.[E1], "=XXX", xlWhole
Set Rng = .SpecialCells(xlCellTypeFormulas, xlErrors)
Rng.Cells = Sheet6.[E1]
F1 = Application.Match(Sheet6.[F1], Rng.Offset(, 3), 0)
F2 = Application.Match(Sheet6.[G1], Rng.Offset(, 5), 0)
If Not IsError(F1) And Not IsError(F2) Then
If F1 = F2 Then Rng(F1, 2).Select
If F1 <> F2 Then Rng(Rng.Rows.Count, 2).Select
Else
Rng(Rng.Rows.Count, 2).Select
End If
Else
.Parent.Range("A" & .Parent.Rows.Count).End(xlUp).Offset(1).Select
End If
End With
End Sub

複製代碼

感恩的心......(在麻辣家族討論區.用心學習會有進步的)
但資源無限,後援有限, 一天1元的贊助,人人有能力.

高中生 Rank: 3 Rank: 3

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

論壇贊助勳章論壇榮譽勳章

3^#

發表於 2013-9-29 15:35 | 只看該作者

回復 2# GBKEE
良師!謝謝!!
再麻煩看看這個檔案謝謝再三!!

LeoV76.rar (11.37 KB)

超級版主 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兔年全勤獎章

2^#

發表於 2013-9-29 12:50 | 只看該作者

回復 1# myleoyes
試試看

Sub 插入()
Dim R As Range, S As String
Set R = ActiveCell
If R.Column >= 1 And R.Column <= 17 Then
If R.Row > 1 And Cells(Rows.Count, R.Column).End(xlUp).Row >= R.Row Then
With Range("A" & R.Row + 1 & ":Q" & R.Row + 1)
.Insert
End With
With Range("A" & R.Row & ":Q" & R.Row)
.Copy .Offset(1, 0)
End With
End If
End If
With ActiveCell
.Offset(1, 0) = Date
ag:
ZZ = Application.InputBox("請輸入名稱", " 輸入新增名稱", Selection.Offset(1, 3), Type:=2)
If ZZ = False Then GoTo ag
.Offset(1, 3) = ZZ
ag1:
ZZ = Application.InputBox("請輸入數字", " 輸入儲存格位子", Type:=1)
If ZZ = False Then GoTo ag1
S = "='" & ThisWorkbook.Path & "\[" & .Offset(1, 3) & ".xls]Sheet1'!$C$" & ZZ
.Offset(1, 8) = S
S = "=IF(RC[5]="""",LOOKUP(9.9E+307,'" & ThisWorkbook.Path & "\[" & .Offset(1, 3) & ".xls]Sheet1'!C2),RC[5])"
.Offset(1, 9) = S
End With
End Sub

複製代碼

感恩的心......(在麻辣家族討論區.用心學習會有進步的)
但資源無限,後援有限, 一天1元的贊助,人人有能力.

靜思自在 : 心中常存善解、包容、感思、知足、惜福。

返回列表下一主題上一主題