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

標題: 還原與備份 [打印本頁]

作者: myleoyes 時間: 2010-6-8 20:51 標題: 還原與備份

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

作者: GBKEE 時間: 2010-6-9 07:15

回復 1# myleoyes

Sub 還原()
Dim F As Range
With ActiveSheet
Set F = .Rows(1).Cells.Find(.Cells(1, ActiveCell.Column))
If F = "" Then
MsgBox "沒有標題"
Exit Sub
End If
Set F = .Range(F.Offset(2), F.Offset(, 20).End(xlDown))
End With
Sheets("分析").Select
Range("A3:U" & Range("A3").End(xlDown).Row).Clear
F.Copy Range("A3")
End Sub

複製代碼

作者: myleoyes 時間: 2010-6-9 08:20

GBKEE前輩你好!
　　　　良師!!哇太棒囉!!接著備份程式請再辛苦囉!
如附檔案說明請再辛苦囉!謝謝再三!!

作者: GBKEE 時間: 2010-6-9 17:15

本帖最後由 GBKEE 於 2010-6-10 07:17 編輯

回復 3# myleoyes
Sub 比對備份()

Dim d As Object, Rng As Range, E As Range, M%, R, i%

Set d = CreateObject("Scripting.Dictionary")

With Sheets("比對備份")

      If .Range("iv1").End(xlToLeft).Column > 1 Then '已有備份資料

         Set Rng = .Range("B1", .Range("iv1").End(xlToLeft))  '備份資料欄位範圍

         Set E = Rng(1, Rng.Columns.Count + 1) '設立要加入備份資料欄位的位置

         M = Application.Max(Rng)             '取得已有備份資料中第1列內相同項目的最大數

      Else                                     '沒有備份資料

         Set E = .Range("B1")

         M = 0

      End If

End With

Set Rng = Range("A1").CurrentRegion

Set Rng = Range("C1", Rng(Rng.Rows.Count, Rng.Columns.Count)) '備份資料的範圍

i = 1

For Each R In Rng.Rows(1).Cells

      If Not d.Exists(R.Value) Then

         d(R.Value) = i '設定複製資料內第1列相同項目的數值

         i = i + 1

      End If

Next

Rng.Copy E

i = 0

Do While E.Offset(, i) <> ""

      If d.Exists(E.Offset(, i).Value) Then E.Offset(, i) = d(E.Offset(, i).Value) + M

      '修改複製資料後第1列相同項目新增的數值

      '->設定複製資料內第1列相同項目的數值 + 已有備份資料中第1列內相同項目的最大數

      i = i + 1

Loop

End Sub
複製代碼

作者: myleoyes 時間: 2010-6-9 22:51

回復 4# GBKEE
GBKEE前輩你好!
　　　　良師!!程式的編號有出入...
如附檔案說明請再辛苦囉!謝謝再三!!
晚安!!

作者: GBKEE 時間: 2010-6-10 07:16

回復 5# myleoyes
請加上紅色部分
Do While E.Offset(, i) <> ""
      If d.Exists(E.Offset(, i).Value) Then E.Offset(, i) = d(E.Offset(, i).Value) + M
      '修改複製資料後第1列相同項目新增的數值
      '->設定複製資料內第1列相同項目的數值 + 已有備份資料中第1列內相同項目的最大數
      i = i + 1
Loop

作者: myleoyes 時間: 2010-6-10 08:46

回復 6# GBKEE
GBKEE前輩你好!
　　　　良師!!不好意思請再幫忙這個刪除鈕
如附檔案說明請再辛苦囉!謝謝再三!!

作者: GBKEE 時間: 2010-6-10 09:12

回復 7# myleoyes

Sub 刪除()
Dim F As Range, i%
With ActiveSheet
Set F = .Rows(1).Cells.Find(.Cells(1, ActiveCell.Column))
i = 1
Do
If F.Offset(, i) <> F Then
Set F = .Range(F, F.Offset(, i - 1))
Exit Do
End If
i = i + 1
Loop
End With
F.EntireColumn.Delete
End Sub

複製代碼

作者: myleoyes 時間: 2010-6-10 21:03

回復 8# GBKEE

GBKEE前輩你好!
　　　　良師!!程式有問題
如附檔案說明請再辛苦囉!謝謝再三!!

作者: GBKEE 時間: 2010-6-11 07:21

回復 9# myleoyes
我執行沒有問題的選擇那一個編號就刪掉那一個編號的範圍沒錯
為防止錯誤修改如下

Sub 刪除()
Dim F As Range, i%
If ActiveCell.Column <= 2 Then Exit Sub
With ActiveSheet
Set F = .Rows(1).Cells.Find(.Cells(1, ActiveCell.Column))
If F = "" Then Exit Sub
i = 1
Do
If F.Offset(, i) <> F Then
Set F = .Range(F, F.Offset(, i - 1))
Exit Do
End If
i = i + 1
Loop
End With
F.EntireColumn.Delete
End Sub

複製代碼

作者: myleoyes 時間: 2010-6-11 11:28

回復 10# GBKEE
GBKEE前輩你好!
　　　　良師!!結果是一樣耶!
         小弟將執行的結果附檔案Leov6-2說明
               小弟修改程式後執行的結果附檔案Leov6-3說明
               請再辛苦囉!謝謝再三!!

作者: GBKEE 時間: 2010-6-11 13:58

回復 11# myleoyes
選擇編號3 的錯誤修改如下
Set F = .Rows(1).Cells.Find(.Cells(1, ActiveCell.Column), After:=.[b1])
致於選擇編號1-2 錯誤請看如圖告訴我 S欄-W欄是1 還是 2 . 是你錯還是我錯. 一定有人錯的
[attach]1219[/attach]

作者: myleoyes 時間: 2010-6-11 21:56

回復 12# GBKEE
GBKEE前輩你好!
　　　　良師!!歹勢啦!!是我錯囉!!對不起...
讓你忙壞嚕!謝謝再三!!

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