返回列表 上一主題 發帖

4個VBA問題

1
  1. [D1]=Range("B" & trim(str(n)) & "  " &  Range("C"& trim(str(i)))
複製代碼
不太明你想要的是什麼

2
  1. sheets(2)
複製代碼
SHEET2 不一定是第2, 你可以先用sheets("abc").index 來找位置

3
跟第2題的同一道理

4 如果你想關excel後數字還在, 就要找個位置把以下d的東西存起
  1. Sub test()
  2.     Static d
  3.     If IsEmpty(d) Then
  4.         Set d = CreateObject("Scripting.Dictionary")
  5.     End If
  6.     v = Range("a1").Value
  7.     If d.exists(v) Then
  8.         d(v) = d(v) + 1
  9.     Else
  10.         Call d.Add(v, 1)
  11.     End If
  12.     Range("C1") = d(v)
  13. End Sub
複製代碼
懂得發問,答案就會在其中

今日の一秒は  明日にない
http://kimbalko-chi.blogspot.com
http://kimbalko.blogspot.com

TOP

回復  GBKEE

1-3都明白了  謝謝2位大大

4
Set =Sheet1.Range("A65536")  這個有問題.
如果要del   ...
basarasy 發表於 2010-7-24 20:04


    不如你先了解一下Static  和 Scripting.Dictionary 是什麼.
了解後你就會知道 " eg.   as=1    gh=3    hu=10"  的要如何做.
不明白可以在這裡問問~

static的意思大約是"暫存" 在module reset前會把數值記起來.
scripting.dictionary可參考一下這裡
http://forum.twbts.com/viewthread.php?tid=20

有關之前說的,把scripting.dictionary的置存到sheet上
跟玩游戲一樣
在a1 輸入SAVE, 會把所有次數放在entries一頁,
在a1 輸入load時, 把所有次數由entries一頁復原
  1.    
  2.     Static d
  3.     Set acsht = ActiveSheet
  4.     v = Range("a1").Value
  5.     If v = "LOAD" Then
  6.         d = Null
  7.     End If
  8.    
  9.     If IsEmpty(d) Or IsNull(d) Then
  10.         Set d = CreateObject("Scripting.Dictionary")
  11.         If v = "LOAD" Then
  12.             Sheets("Entries").Select
  13.             If Range("A1") <> "" Then
  14.                 For i = ActiveSheet.UsedRange.Rows.Count To 1 Step -1
  15.                     v2 = Range("A1").Offset(i - 1)
  16.                     If d.exists(Range("A1").Offset(i - 1)) Then
  17.                         d(v2) = Range("A1").Offset(i - 1, 1)
  18.                     Else
  19.                         Call d.Add(v2, 1)
  20.                     End If
  21.                 Next
  22.             Else
  23.                 d = Null
  24.             End If
  25.             acsht.Select
  26.             Range("C1") = "LOADED"
  27.             Exit Sub
  28.         End If
  29.     Else
  30.         If v = "SAVE" Then
  31.             Sheets("Entries").Select
  32.             Cells.Clear
  33.             dk = d.keys
  34.             di = d.Items
  35.             Range("A1").Resize(UBound(dk) + 1).Value = WorksheetFunction.Transpose(dk)
  36.             Range("B1").Resize(UBound(di) + 1).Value = WorksheetFunction.Transpose(di)
  37.             acsht.Select
  38.             Range("C1") = "SAVED"
  39.             Exit Sub
  40.         End If
  41.     End If
  42.    
  43.     If d.exists(v) Then
  44.         d(v) = d(v) + 1
  45.     Else
  46.         Call d.Add(v, 1)
  47.     End If
  48.     Range("C1") = d(v)
複製代碼
懂得發問,答案就會在其中

今日の一秒は  明日にない
http://kimbalko-chi.blogspot.com
http://kimbalko.blogspot.com

TOP

本帖最後由 kimbal 於 2010-7-25 09:58 編輯

回復 7# basarasy


    有關4的問題, 或者換個方法吧
用前不要忘了加 entries一頁
  1.     On Error Resume Next
  2.     Dim currRow As Long
  3.     Dim e As Integer
  4.     Dim nextvalue As Integer
  5.     Dim sheetname As String
  6.     sheetname = Worksheets("entries").Name
  7.    
  8.     If sheetname = "" Then
  9.         MsgBox ("Sheet ""entries"" not found!")
  10.         Exit Sub
  11.     End If
  12.     currRow = 0
  13.     v = Range("A1").Value
  14.     e = Range("E1").Value
  15.    
  16.     currRow = WorksheetFunction.Match(v, Worksheets(sheetname).Range("A:A"), False)
  17.     With Worksheets(sheetname)
  18.         If currRow = 0 Then
  19.             currRow = .Range("A65536").End(xlUp).Row + 1
  20.             nextvalue = 1
  21.         Else
  22.             nextvalue = .Range("A1").Offset(currRow - 1, 1) + 1
  23.         End If
  24.         If e > 0 Then
  25.             nextvalue = e
  26.         End If
  27.         .Range("A1").Offset(currRow - 1, 1) = nextvalue
  28.     End With
  29.    
  30.     If currRow > 0 Then
  31.         Range("C1").Value = nextvalue
  32.     End If
複製代碼
有關forumla的問題:
  1. Range("AA3").Formula = "=IF(" & MyName & "!C2="""","""",VLOOKUP(A2,poi!$A$2C$501,3,0))"
複製代碼
懂得發問,答案就會在其中

今日の一秒は  明日にない
http://kimbalko-chi.blogspot.com
http://kimbalko.blogspot.com

TOP

本帖最後由 kimbal 於 2010-7-25 14:13 編輯

回復 9# basarasy

有關"有少少問題"...
  1. On Error Resume Next
  2.     Dim currRow As Long
  3.     Dim es As String
  4.     Dim e As Integer
  5.     Dim nextvalue As Integer
  6.     Dim sheetname As String
  7.     sheetname = Worksheets("entries").Name
  8.    
  9.     If sheetname = "" Then
  10.         MsgBox ("Sheet ""entries"" not found!")
  11.         Exit Sub
  12.     End If
  13.     currRow = 0
  14.    
  15.     v = Range("A1").Value
  16.     es = Range("E1").Value
  17.     e = Range("F1").Value
  18.     If es <> "" Then
  19.         v = es
  20.     Else
  21.         e = 0
  22.     End If
  23.    
  24.     currRow = WorksheetFunction.Match(v, Worksheets(sheetname).Range("A:A"), False)
  25.     With Worksheets(sheetname)
  26.         If currRow = 0 Then
  27.             currRow = .Range("A65536").End(xlUp).Row + 1
  28.             nextvalue = 1
  29.         Else
  30.             nextvalue = .Range("A1").Offset(currRow - 1, 1) + 1
  31.         End If
  32.         If e > 0 Then
  33.             nextvalue = e
  34.         End If
  35.         .Range("A1").Offset(currRow - 1, 1) = nextvalue
  36.     End With
  37.    
  38.     If currRow > 0 Then
  39.         Range("C1").Value = nextvalue
  40.     End If
複製代碼
Workbooks(AA).Close SaveChanges:=False
Close argument 下的filename 是用來指定close後把excel存成新的檔名,
而不是用來指定關那個book
懂得發問,答案就會在其中

今日の一秒は  明日にない
http://kimbalko-chi.blogspot.com
http://kimbalko.blogspot.com

TOP

回復 11# basarasy
有關c1問題, 之次錯刪了一下,可以再試試這個
  1.     On Error Resume Next
  2.     Dim currRow As Long
  3.     Dim es As String
  4.     Dim e As Integer
  5.     Dim nextvalue As Integer
  6.     Dim sheetname As String
  7.    
  8.     sheetname = Worksheets("entries").Name
  9.    
  10.     If sheetname = "" Then
  11.         MsgBox ("Sheet ""entries"" not found!")
  12.         Exit Sub
  13.     End If
  14.     currRow = 0
  15.    
  16.     v = Range("A1")
  17.    
  18.     es = Range("E1").Value
  19.     e = Range("F1").Value
  20.     If es <> "" Then
  21.         v = es
  22.     Else
  23.         e = 0
  24.     End If
  25.    
  26.     currRow = WorksheetFunction.Match(v, Worksheets(sheetname).Range("A:A"), False)
  27.     With Worksheets(sheetname)
  28.         If currRow = 0 Then
  29.             currRow = .Range("A65536").End(xlUp).Row + 1
  30.             .Range("A1").Offset(currRow - 1) = v
  31.             nextvalue = 1
  32.         Else
  33.             nextvalue = .Range("A1").Offset(currRow - 1, 1) + 1
  34.         End If
  35.         If e > 0 Then
  36.             nextvalue = e
  37.         End If
  38.         .Range("A1").Offset(currRow - 1, 1) = nextvalue
  39.     End With
  40.    
  41.     If currRow > 0 Then
  42.         Range("C1").Value = nextvalue
  43.     End If
複製代碼
這個或者你試試自己動手吧,
"可以加多個g1   if  g1=1 就把 所有save的東西del"
save的代碼是
thisworkbook.save

"還有,如果我這個excel有問題,"
可以,vba內容跟沒有跟workbook定位.... 你也試試了解一下中關運作吧~有行數不明白可以問一下的.
懂得發問,答案就會在其中

今日の一秒は  明日にない
http://kimbalko-chi.blogspot.com
http://kimbalko.blogspot.com

TOP

回復 13# basarasy


有關 "e1  and  f1  有問題"
可以把
    Dim es As String
的 as string 拿走就可以了

"如果我要把entries的東西save在 其他excel要如果寫?"
學習巨集基本法: 錄製巨集

在excel上
1. 開發人員->錄製巨集, 按確定
2. 常用->儲存格->格式->移動或複製工作表, 選位置
3. 開發人員->停止錄製
到vbe查看巨集
懂得發問,答案就會在其中

今日の一秒は  明日にない
http://kimbalko-chi.blogspot.com
http://kimbalko.blogspot.com

TOP

        靜思自在 : 【時日莫空過】一個人在世間做了多少事,就等於壽命有多長。因此必須與時間競爭,切莫使時日空過。
返回列表 上一主題