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

標題: 4個VBA問題 [打印本頁]

作者: basarasy 時間: 2010-7-24 13:57 標題: 4個VBA問題

第1  sheet1 B1=2  C1=M
dim n ,i
[D1]="Range("B"& n) Range("C"& i)"  (因為 Range會變要這樣寫)

第2  好多時我都在sheet1 用按鈕run vba 1開始要在sheet2  我會先寫
sheets("sheet2").Select
但sheet2的名改了 "abc"  在vba又要改sheets("abc").Select
有什麼寫改了sheet名都可以正常run vba.

第3
這樣寫對嗎?
sheets("sheet2").Range("A1").Value=sheets("sheet1").Range("A1").Value
如果改了sheet名都可以run要如何寫?

第4
這個很難><
sheet2

a1= 10 / 明/abc

當a1輸入1個數or文字按run if  a1的數or文字是第1次入的時候  c1會出1 vba會記載這個數or文字
                                          if  第2入就 c1出2 .....................

eg.
a1=10 > run>c1=1 > a1=momo>run>c1=1  > save  execl off execl  >open excel > a1=momo>run>c1=2  >a1=haha>run>c1=1

如果a1的數or文字有 300多個 vba可以save嗎?

作者: kimbal 時間: 2010-7-24 15:56

1

[D1]=Range("B" & trim(str(n)) & " " & Range("C"& trim(str(i)))

複製代碼

不太明你想要的是什麼

2

sheets(2)

複製代碼

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

3
跟第2題的同一道理

4 如果你想關excel後數字還在, 就要找個位置把以下d的東西存起

Sub test()
Static d
If IsEmpty(d) Then
Set d = CreateObject("Scripting.Dictionary")
End If
v = Range("a1").Value
If d.exists(v) Then
d(v) = d(v) + 1
Else
Call d.Add(v, 1)
End If
Range("C1") = d(v)
End Sub

複製代碼

作者: basarasy 時間: 2010-7-24 16:19

回復 2# kimbal

1
是想在d1出 "[b1]的數or文字 [c1]的數or文字"
eg. b1=4  c1=t  > d1=  "4  t"

2
只要sheet不移動,就可以用sheets(1).Select嗎?用sheets(1).Select  sheet改名都冇問題嗎?

4
找個位置把以下d的東西存起
不是很明.
dim MySave
MySave=d    ??

作者: GBKEE 時間: 2010-7-24 17:34

回復 3# basarasy
1 [d1]= [b1]&" "&[c1]
2 用CodeName
如 Sheets("sheet1")  是  Sheet1  ->  Sheet1.Select
如 Sheets("sheet2")  是 Sheet2  ->  Sheet2.Select
3 sheets("sheet2").Range("A1").Value=sheets("sheet1").Range("A1").Value
->Sheet2.Range("A1").Value=Sheet1.Range("A1").Value
4 dim MySave
Set =Sheet1.Range("A65536")
MySave.Value=d

作者: basarasy 時間: 2010-7-24 20:04

回復 4# GBKEE

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

4
Set =Sheet1.Range("A65536")  這個有問題.
如果要del d這個數重頭開始過,寫1句 MySave.del  對嗎?

如果 d  save了幾個數可以改嗎?
eg. as=1 gh=3 hu=10 我可以在e1打hu 在f1打9 (a1=hu) 之後run 1次  c1就會出10

作者: kimbal 時間: 2010-7-25 00:01

回復  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一頁復原

Static d
Set acsht = ActiveSheet
v = Range("a1").Value
If v = "LOAD" Then
d = Null
End If
If IsEmpty(d) Or IsNull(d) Then
Set d = CreateObject("Scripting.Dictionary")
If v = "LOAD" Then
Sheets("Entries").Select
If Range("A1") <> "" Then
For i = ActiveSheet.UsedRange.Rows.Count To 1 Step -1
v2 = Range("A1").Offset(i - 1)
If d.exists(Range("A1").Offset(i - 1)) Then
d(v2) = Range("A1").Offset(i - 1, 1)
Else
Call d.Add(v2, 1)
End If
Next
Else
d = Null
End If
acsht.Select
Range("C1") = "LOADED"
Exit Sub
End If
Else
If v = "SAVE" Then
Sheets("Entries").Select
Cells.Clear
dk = d.keys
di = d.Items
Range("A1").Resize(UBound(dk) + 1).Value = WorksheetFunction.Transpose(dk)
Range("B1").Resize(UBound(di) + 1).Value = WorksheetFunction.Transpose(di)
acsht.Select
Range("C1") = "SAVED"
Exit Sub
End If
End If
If d.exists(v) Then
d(v) = d(v) + 1
Else
Call d.Add(v, 1)
End If
Range("C1") = d(v)

複製代碼

作者: basarasy 時間: 2010-7-25 00:59

回復 6# kimbal
謝謝kimbal的教導static同scripting.dictionary,但是太難了><  要慢慢學.
你打的vba不能用.
可以這樣嗎?
第1個sub  寫
Sub test()
Static d
If IsEmpty(d) Then
      Set d = CreateObject("Scripting.Dictionary")
End If
v = Range("a1").Value
If d.exists(v) Then
      d(v) = d(v) + 1
Else
      Call d.Add(v, 1)
End If
Range("C1") = d(v)
End Sub

第2個sub  寫
把Static d  save  到 dim MySave
如果vba的MySave不能在off excel再open excel用就save在 [z1]

第3個sub  寫
把Static d  初期化  del  Static d內所有東西(數or文字)

第4個sub  寫
a1=hu run2次 c1會出2
在e1打hu 在f1打1 (a1=hu) 之後run 1次  c1就會出2(這個是改Static d入面的數)

最後有1個問題是
MyName = Sheet3.Name    (Sheet3.Name=人)

Range("AA3").Formula = "=IF(MyName!C2="""","""",VLOOKUP(A2,poi!$A$2

C$501,3,0))"
這個如何寫才可以在aa3出 "=IF(人!C2="","",VLOOKUP(A2,poi!$A$2

C$501,3,0))"

作者: kimbal 時間: 2010-7-25 09:40

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

回復 7# basarasy

有關4的問題, 或者換個方法吧
用前不要忘了加 entries一頁

On Error Resume Next
Dim currRow As Long
Dim e As Integer
Dim nextvalue As Integer
Dim sheetname As String
sheetname = Worksheets("entries").Name
If sheetname = "" Then
MsgBox ("Sheet ""entries"" not found!")
Exit Sub
End If
currRow = 0
v = Range("A1").Value
e = Range("E1").Value
currRow = WorksheetFunction.Match(v, Worksheets(sheetname).Range("A:A"), False)
With Worksheets(sheetname)
If currRow = 0 Then
currRow = .Range("A65536").End(xlUp).Row + 1
nextvalue = 1
Else
nextvalue = .Range("A1").Offset(currRow - 1, 1) + 1
End If
If e > 0 Then
nextvalue = e
End If
.Range("A1").Offset(currRow - 1, 1) = nextvalue
End With
If currRow > 0 Then
Range("C1").Value = nextvalue
End If

複製代碼

有關forumla的問題:

Range("AA3").Formula = "=IF(" & MyName & "!C2="""","""",VLOOKUP(A2,poi!$A$2C$501,3,0))"

複製代碼

作者: basarasy 時間: 2010-7-25 11:16

回復 8# kimbal

有少少問題
我想要  if  e1="" 就正常run ,  then if  e1=a1  f1=2(e1和f1都是人手打的) then c1出2 else end
eg.

a1=30  e1="" > run > c1=1 > run > c1=2 > e1=30 f1=1 > run > c1=f1=1 > e1="" > run > c1=2

請問
AA = "C:\Documents and Settings\Administrator\桌面\book.xlsm"

Workbooks.Open Filename:=AA  (這個可以run)

Workbooks.Close Filename:=AA , savechanges:=True  (為什麼這個不能run?)

作者: kimbal 時間: 2010-7-25 13:56

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

回復 9# basarasy

有關"有少少問題"...

On Error Resume Next
Dim currRow As Long
Dim es As String
Dim e As Integer
Dim nextvalue As Integer
Dim sheetname As String
sheetname = Worksheets("entries").Name
If sheetname = "" Then
MsgBox ("Sheet ""entries"" not found!")
Exit Sub
End If
currRow = 0
v = Range("A1").Value
es = Range("E1").Value
e = Range("F1").Value
If es <> "" Then
v = es
Else
e = 0
End If
currRow = WorksheetFunction.Match(v, Worksheets(sheetname).Range("A:A"), False)
With Worksheets(sheetname)
If currRow = 0 Then
currRow = .Range("A65536").End(xlUp).Row + 1
nextvalue = 1
Else
nextvalue = .Range("A1").Offset(currRow - 1, 1) + 1
End If
If e > 0 Then
nextvalue = e
End If
.Range("A1").Offset(currRow - 1, 1) = nextvalue
End With
If currRow > 0 Then
Range("C1").Value = nextvalue
End If

複製代碼

Workbooks(AA).Close SaveChanges:=False
Close argument 下的filename 是用來指定close後把excel存成新的檔名,
而不是用來指定關那個book

作者: basarasy 時間: 2010-7-25 15:30

回復 10# kimbal
RUN時有問題
A1=10  E1="">RUN 2次>  C1出1(正常C1會出2 )
18-21.那裡是要 IF  ES<>"" AND V=ES  THEN....>RUN >C1=e
可以加多個g1 if  g1=1 就把所有save的東西del. 還有,如果我這個excel有問題,可以把save的東西copy到第2個excel嗎?

作者: kimbal 時間: 2010-7-25 15:58

回復 11# basarasy
有關c1問題, 之次錯刪了一下,可以再試試這個

On Error Resume Next
Dim currRow As Long
Dim es As String
Dim e As Integer
Dim nextvalue As Integer
Dim sheetname As String
sheetname = Worksheets("entries").Name
If sheetname = "" Then
MsgBox ("Sheet ""entries"" not found!")
Exit Sub
End If
currRow = 0
v = Range("A1")
es = Range("E1").Value
e = Range("F1").Value
If es <> "" Then
v = es
Else
e = 0
End If
currRow = WorksheetFunction.Match(v, Worksheets(sheetname).Range("A:A"), False)
With Worksheets(sheetname)
If currRow = 0 Then
currRow = .Range("A65536").End(xlUp).Row + 1
.Range("A1").Offset(currRow - 1) = v
nextvalue = 1
Else
nextvalue = .Range("A1").Offset(currRow - 1, 1) + 1
End If
If e > 0 Then
nextvalue = e
End If
.Range("A1").Offset(currRow - 1, 1) = nextvalue
End With
If currRow > 0 Then
Range("C1").Value = nextvalue
End If

複製代碼

這個或者你試試自己動手吧,
"可以加多個g1 if g1=1 就把所有save的東西del"
save的代碼是
thisworkbook.save

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

作者: basarasy 時間: 2010-7-25 16:28

本帖最後由 basarasy 於 2010-7-25 17:05 編輯

回復 12# kimbal

大多都明白了.謝謝大大
只要把entries del就可以初期化了.

e1  and  f1  有問題
我入e1同f1 其實是  當我a1=10時不小心按了2下run  c1出了2  之後入e1=10 f1=1 >run  c1就會
變回1.  不用把e1同f1 save在entries,只要改entries內對照的b:b 就ok了.

不save是否改
If es = "" Then
         .Range("A1").Offset(currRow - 1) = v
         End If

If es = "" Then
      .Range("A1").Offset(currRow - 1, 1) = nextvalue
      End If  這個?

但改entries內對照的b:b不知改那裡.

作者: basarasy 時間: 2010-7-25 19:13

如果我要把entries的東西save在其他excel要如果寫?

作者: kimbal 時間: 2010-7-25 21:07

回復 13# basarasy

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

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

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

作者: basarasy 時間: 2010-7-25 21:19

回復 15# kimbal

謝謝大大^^

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