Sub 更新乾重()
Dim a_sum(8), b_sum(8), c_sum(8), my_sum(8)
Set D = CreateObject("Scripting.dictionary")
If D.exists("D:\mydocument\0青蔥試驗\採收調查\DATA-KEYIN\冬SEAWEED.xls") = False Then
Workbooks.Open Filename:="D:\mydocument\0青蔥試驗\採收調查\DATA-KEYIN\冬SEAWEED.xls"
End If
ActiveWorkbook.SaveCopyAs ("D:\mydocument\0青蔥試驗\採收調查\資料分析\冬SEAWEED.xls")
If D.exists("D:\mydocument\0青蔥試驗\採收調查\DATA-KEYIN\冬乾SEAWEED.xls") = False Then
Workbooks.Open Filename:="D:\mydocument\0青蔥試驗\採收調查\DATA-KEYIN\冬乾SEAWEED.xls"
End If
ActiveWorkbook.SaveCopyAs ("D:\mydocument\0青蔥試驗\採收調查\資料分析\冬乾SEAWEED.xls")
Application.DisplayAlerts = False '關閉警告視窗
my_count = Worksheets.Count
'MsgBox my_count
For i = 1 To my_count
Workbooks("冬乾SEAWEED.xls").Sheets(i).Activate
Randomize
Weight = Rnd(2) / 3 + 1.15
For j = 3 To (Cells(2, 3).End(xlDown).Row - 1)
dry_w = Cells(j, 4).Value 'dry weight
Workbooks("冬SEAWEED.xls").Sheets(1).Activate
Set iti = Cells.Find(What:=moji, After:=ActiveCell)
If iti Is Nothing Then
'MsgBox "找不到您想要找的資料"
Else
iti.Activate
'Debug.Print iti.Row
End If
Set it2 = Cells.Find(What:="蔥白重", After:=ActiveCell)
If it2 Is Nothing Then
'MsgBox "找不到您想要找的資料"
Else
it2.Activate
'Debug.Print it2.Column
End If
'Debug.Print Cells(iti.Row + 1, it2.Column).Value
wt = Cells(iti.Row + 1, it2.Column).Value 'fresh weight
'Debug.Print wt
Workbooks("冬乾SEAWEED.xls").Sheets(i).Activate
If (wt * 10000 / dry_w) < 10 Then
Cells(j, 4).Value = Int(Cells(j, 4).Value / Weight)
Cells(j, 4).Font.ColorIndex = 22
End If
Next
For k = 3 To (Cells(2, 8).End(xlDown).Row - 1)
dry_w = Cells(k, 8).Value 'dry weight
Workbooks("冬SEAWEED.xls").Sheets(i).Activate
Set iti = Cells.Find(What:=moji, After:=ActiveCell)
If iti Is Nothing Then
'MsgBox "找不到您想要找的資料"
Else
iti.Activate
'Debug.Print iti.Row
End If
Set it2 = Cells.Find(What:="蔥白重", After:=ActiveCell)
If it2 Is Nothing Then
'MsgBox "找不到您想要找的資料"
Else
it2.Activate
'Debug.Print it2.Column
End If
'Debug.Print Cells(iti.Row + 1, it2.Column).Value
wt = Cells(iti.Row + 1, it2.Column).Value 'fresh weight
'Debug.Print wt
Workbooks("冬乾SEAWEED.xls").Sheets(i).Activate
If (wt * 10000 / dry_w) < 10 Then
Cells(k, 8).Value = Int(Cells(k, 8).Value / Weight)
Cells(k, 8).Font.ColorIndex = 22
End If
Next
Next
End Sub
留言列表
