有没有能自动生成VB.NET程序设计代码的软件
Excel中的VB语言叫做VBA,在VBE中使用代码新建即可Excel版本参考:2010演示:新建一个表名为test的工作表1、ALT+F11,进入VBE窗口2、右击工作表标签-插入-模块3、输入代码:Sub test()Worksheets.Add(after:=Sheets(Sheets.Count)).Name = "test"End Sub4、按下F5执行,查看工作表,新建的test表 已新建好
...结构相同,请问怎么用VB比较两个表的内容是否一致,并自动生成第...
纯手写的测试OK了有点小辛苦望采纳我用的VB6.0新建工程-引用-Microsoft Excel 11.0 Object Library或其它版本添加一个按钮-双击按钮粘贴下面代码Dim Xls As New Excel.Application '定义excel应用程序Dim Xlsbook As Excel.Workbook '定义工作簿Dim Xlssheet(3) As Excel.Worksheet '定义工作表Xls.Visible = True '显示excel 程序Xls.SheetsInNewWorkbook = 1Set Xlsbook = Xls.Application.Workbooks.Open("C:\Documents and Settings\Administrator\桌面\Book1.xls") '这里改成自己的xls路经Set Xlssheet(1) = Xlsbook.Sheets(1) '第1个工作表的控制句柄Set Xlssheet(2) = Xlsbook.Sheets(2)If Xlsbook.Sheets.Count Xlsbook.Sheets(1).SelectXlsbook.Sheets.AddXlsbook.Sheets(1).Move After:=Xlsbook.Sheets(Xlsbook.Sheets.Count)End IfSet Xlssheet(3) = Xlsbook.Sheets(Xlsbook.Sheets.Count)Dim pd As String,i As Long,j As Longpd = Xlssheet(1).Range("A1").FormulaR1C1i = 65j = 1Do While pd & "" ""pd = Xlssheet(1).Range(Chr(i) & j).FormulaR1C1Do While pd & "" ""If Xlssheet(1).Range(Chr(i) & j).FormulaR1C1 = Xlssheet(2).Range(Chr(i) & j).FormulaR1C1 ThenXlssheet(3).Range(Chr(i) & j).FormulaR1C1 = "相同"ElseXlssheet(3).Range(Chr(i) & j).FormulaR1C1 = "不相同"End Ifi = i + 1pd = Xlssheet(1).Range(Chr(i) & j).FormulaR1C1Loopi = 65j = j + 1pd = Xlssheet(1).Range(Chr(i) & j).FormulaR1C1DoEventsLoopOn Error GoTo CheckError'Xls.DisplayAlerts = False'Set Xlssheet = Nothing '释放资源'Xlsbook.Saved = True'Xlsbook.Close False'Set Xlsbook = Nothing '释放资源'Xls.Quit '退出excel应用程序'Set Xls = NothingCheckError:''''''''''''''''''''''''''''''''''''''''''''''''''拖拽版.新建工程-引用-Microsoft Excel 11.0 Object Library或其它版本直接粘贴下面代码运行后将Excel拖到VB程序的界面上就出结果了Private Sub Form_Load()Me.OLEDropMode = 1End SubFunction GetTargetPath(ByVal LinkName As String)On Local Error Resume NextDim Obj As ObjectSet Obj = CreateObject("Wscript.Shell")Dim Shortcut As ObjectSet Shortcut = Obj.CreateShortcut(LinkName)GetTargetPath = Shortcut.TargetPathShortcut.SaveEnd FunctionPrivate Sub Form_OLEDragDrop(Data As DataObject,Effect As Long,Button As Integer,Shift As Integer,X As Single,Y As Single)Dim lj As StringOn Local Error Resume NextIf Right(Data.Files.Item(1),3) "lnk" And Right(Data.Files.Item(1),3) "xls" Then Exit Sublj = Data.Files.Item(1)If Right(Data.Files.Item(1),3) = "lnk" Thenlj = GetTargetPath(Data.Files.Item(1))End IfIf Right(lj,3) = "xls" ThenDim Xls As New Excel.Application '定义excel应用程序Dim Xlsbook As Excel.Workbook '定义工作簿Dim Xlssheet(3) As Excel.Worksheet '定义工作表Xls.Visible = True '显示excel 程序Xls.SheetsInNewWorkbook = 1Set Xlsbook = Xls.Application.Workbooks.Open(lj)Set Xlssheet(1) = Xlsbook.Sheets(1) '第1个工作表的控制句柄Set Xlssheet(2) = Xlsbook.Sheets(2)If Xlsbook.Sheets.Count Xlsbook.Sheets(1).SelectXlsbook.Sheets.AddXlsbook.Sheets(1).Move After:=Xlsbook.Sheets(Xlsbook.Sheets.Count)End IfSet Xlssheet(3) = Xlsbook.Sheets(Xlsbook.Sheets.Count)Dim pd As String,i As Long,j As Longpd = Xlssheet(1).Range("A1").FormulaR1C1i = 65j = 1Do While pd & "" ""pd = Xlssheet(1).Range(Chr(i) & j).FormulaR1C1Do While pd & "" ""If Xlssheet(1).Range(Chr(i) & j).FormulaR1C1 = Xlssheet(2).Range(Chr(i) & j).FormulaR1C1 ThenXlssheet(3).Range(Chr(i) & j).FormulaR1C1 = "相同"ElseXlssheet(3).Range(Chr(i) & j).FormulaR1C1 = "不相同"End Ifi = i + 1pd = Xlssheet(1).Range(Chr(i) & j).FormulaR1C1Loopi = 65j = j + 1pd = Xlssheet(1).Range(Chr(i) & j).FormulaR1C1DoEventsLoopEnd IfEnd Sub
VBA按筛选生成新表
展开全部我这里提供两种思路: 各有优缺点:'Option Explicit'用字典编写:Private Sub CommandButton1_Click()Dim d1 As New Dictionary, d2 As New Dictionary, d3 As New DictionaryDim eRow%, R%, S%, T%'定义表名称Sheets.Add after:=Sheets(1)ActiveSheet.Name = "A"Sheets.Add after:=Sheets(2)ActiveSheet.Name = "B"Sheets.Add after:=Sheets(3)ActiveSheet.Name = "C"Sheets(1).ActivateeRow = [A65536].End(3).RowR = Application.WorksheetFunction.CountIf(Range("B1:B" & eRow), "A")S = Application.WorksheetFunction.CountIf(Range("B1:B" & eRow), "B")T = Application.WorksheetFunction.CountIf(Range("B1:B" & eRow), "C")For i = 2 To eRowIf InStr(Cells(i, 2), "A") > 0 Thend1(Cells(i, 1)) = Cells(i, 3)ElseIf InStr(Cells(i, 2), "B") > 0 Thend2(Cells(i, 1)) = Cells(i, 3)ElseIf InStr(Cells(i, 2), "C") > 0 Thend3(Cells(i, 1)) = Cells(i, 3)End IfNext iSheets(2).Range("A1:A" & R) = Application.Transpose(d1.Keys)Sheets(2).Range("B1:B" & R) = Application.Transpose(d1.Items)Sheets(3).Range("A1:A" & S) = Application.Transpose(d2.Keys)Sheets(3).Range("B1:B" & S) = Application.Transpose(d2.Items)Sheets(4).Range("A1:A" & T) = Application.Transpose(d3.Keys)Sheets(4).Range("B1:B" & T) = Application.Transpose(d3.Items)End Sub'普通编写Private Sub CommandButton2_Click()Sheets(2).Delete: Sheets(2).Delete: Sheets(2).Delete:Sheets.Add after:=Sheets(1)ActiveSheet.Name = "A"Sheets.Add after:=Sheets(2)ActiveSheet.Name = "B"Sheets.Add after:=Sheets(3)ActiveSheet.Name = "C"Sheets(1).ActivateeRow = [A65536].End(3).RowFor i = 2 To eRowWith Sheets(1)If InStr(Cells(i, 2), "A") > 0 ThenSheets(2).Activate.Rows(i).Copy Sheets(2).[A65536].End(3).Offset(1, 0)ElseIf InStr(Cells(i, 2), "B") > 0 ThenSheets(3).Activate.Rows(i).Copy Sheets(3).[A65536].End(3).Offset(1, 0)ElseIf InStr(Cells(i, 2), "C") > 0 ThenSheets(4).Activate.Rows(i).Copy Sheets(4).[A65536].End(3).Offset(1, 0)End IfEnd WithNext iEnd Sub看看谁更快,哈哈......
哪里有根据文本中的内容批量生成不同文件名的word文档软件?
1、分别创建两个新的txt文本,A文本【list.txt】是放你要命名的文件名,一行一个;B文本复制粘贴以下的代码,并把后缀文件从txt改为bat,直接运行即可。
@echo offfor /f "usebackq delims=" %%i in ("G:\A文本路径\list.txt") do (echo.>>"%%~i.docx")...
转载请注明出处51数据库 » 自动生成名单vb软件