菜鸟谈VBA最最基础入门《原创》

eliubing

膜拜，感谢啊，

876543210000

口是心非 发表于 2009-8-17 21:25
Sub mysum()
Dim Lsum As Long, i As Long
i = 1

你把Lsum想象成一个大的容器，原来什么东西都没有，现在开始往里面加东西

876543210000

artemis_xu 发表于 2009-8-18 12:19
请问老师，这一段：
Sub 求1到10000之间奇数和2()
    Dim I&, J&

是的，奇数的时候是9999

永在战场

内容太全了，感谢分享！！！！先收藏，慢慢学！！

xuminglei2003

各位大佬，本人菜鸟一枚，对VBA的理解有限，请各位帮忙将我的sheet1 A列录入数据后，B列到F列引用sheet2里面对应的数据，用数组完成。
      为了人性化操作.在sheet1 A列里，可以单独录入数据，也可以批量粘贴数据，都能达到引用的效果，批量删除也要达到该行后面数据的清空效果。
我自己设计的只能单元格录入和删除，不能批量粘贴和批量删除，而且是循环，反应速度很慢！

Private Sub Worksheet_Change(ByVal Target As Range)
Application.ScreenUpdating = False
Dim i%, yrow%
If Target.Count = 1 And Target.Column = 1 And Target.Row > 1 Then
     If Target.Value = "" Then
         Target.Offset(0, 1).Resize(1, 5) = ""
     End If
     yrow = Sheet2.[a65536].End(xlUp).Row
     For i = 2 To yrow
         If Target.Value = Sheet2.Cells(i, 1) Then
             Target.Offset(0, 1) = Sheet2.Cells(i, 2)
             Target.Offset(0, 2) = Sheet2.Cells(i, 3)
             Target.Offset(0, 3) = Sheet2.Cells(i, 4)
             Target.Offset(0, 4) = Sheet2.Cells(i, 5)
             Target.Offset(0, 5) = Sheet2.Cells(i, 6)
         End If
     Next i
End If
Application.ScreenUpdating = True
End Sub

修行21

ggsmart 发表于 2009-8-25 12:21
[试一试]对花名册进行分类

1. Sub mysub()
   
2. 
   
3. Dim i As Long
   
4. Dim MAX As Long
   
5. 
   
6. MAX = [A65536].End(xlUp).Row
   
7. 
   
8. For i = 3 To MAX
   
9.     If Cells(i, 8) = "清镇" Then
   
10.         Select Case Cells(i, 9)
    
11.             Case "卫城"
    
12.                 Range("A" & i & ":L" & i).Select
    
13.                 Selection.Copy
    
14.                 Sheets("卫城").Select
    
15.                 Range("A" & [A65536].End(xlUp).Row + 1).Select
    
16.                 ActiveSheet.Paste
    
17.             Case "站街"
    
18.                 Range("A" & i & ":L" & i).Select
    
19.                 Selection.Copy
    
20.                 Sheets("站街").Select
    
21.                 Range("A" & [A65536].End(xlUp).Row + 1).Select
    
22.                 ActiveSheet.Paste
    
23.             Case "流长"
    
24.                 Range("A" & i & ":L" & i).Select
    
25.                 Selection.Copy
    
26.                 Sheets("流长").Select
    
27.                 Range("A" & [A65536].End(xlUp).Row + 1).Select
    
28.                 ActiveSheet.Paste
    
29.             Case "王庄"
    
30.                 Range("A" & i & ":L" & i).Select
    
31.                 Selection.Copy
    
32.                 Sheets("王庄").Select
    
33.                 Range("A" & [A65536].End(xlUp).Row + 1).Select
    
34.                 ActiveSheet.Paste
    
35.             Case "青龙"
    
36.                 Range("A" & i & ":L" & i).Select
    
37.                 Selection.Copy
    
38.                 Sheets("青龙").Select
    
39.                 Range("A" & [A65536].End(xlUp).Row + 1).Select
    
40.                 ActiveSheet.Paste
    
41.             Case "红枫"
    
42.                 Range("A" & i & ":L" & i).Select
    
43.                 Selection.Copy
    
44.                 Sheets("红枫").Select
    
45.                 Range("A" & [A65536].End(xlUp).Row + 1).Select
    
46.                 ActiveSheet.Paste
    
47.         End Select
    
48.     Else
    
49.         Range("A" & i & ":L" & i).Select
    
50.         Selection.Copy
    
51.         Sheets("清镇市外").Select
    
52.         Range("A" & [A65536].End(xlUp).Row + 1).Select
    
53.         ActiveSheet.Paste
    
54.     End If
    
55.    
    
56.     Sheets("外在本就读花名册").Select
    
57. Next i
    
58. 
    
59. End Sub

复制代码

实现对花名册分类的源码，请老师批阅

修行21

ggsmart 发表于 2009-8-27 12:53
汇总多工作表花名册

　　上一贴中，“花名册分类”的题目主要是检验大家对循环语句、判断语句及一些单元 ...

1. Sub mysub()
   
2.   Dim start As Double
   
3.   start = Timer
   
4.   
   
5.     '在这里添加你的代码
   
6.     For i = 2 To 8
   
7.         For j = 3 To Sheets(i).[B65536].End(xlUp).Row
   
8.             k = Sheets(1).[B65536].End(xlUp).Row + 1
   
9.             
   
10.             Sheets(1).Range("b" & k & ":c" & k).Value = Sheets(i).Range("b" & j & ":c" & j).Value
    
11.             Sheets(1).Range("d" & k).Value = Sheets(i).Range("e" & j).Value
    
12.             Sheets(1).Range("e" & k).Value = Sheets(i).Range("L" & j).Value
    
13.             Sheets(1).Range("f" & k).Value = Sheets(i).Range("k" & j).Value
    
14.         
    
15.         Next j
    
16.     Next i
    
17.    
    
18.   
    
19.   MsgBox "程序共执行了" & Timer - start & "秒!"
    
20. End Sub

复制代码

请批阅。

yiran7810

谢谢楼主，并致敬意。

17739275008

在哪里能够买到这本书

stellasss

马可2页14楼