我没办法了。还要麻烦大家帮忙解释代码了。
实在不好意思。我马上要把收集的这些材料上交了。可要我注释每段代码。有点难度。所以又来求助各位了。但愿不要闲烦。呵呵！！请帮帮忙。谢谢！！！
一、
VB code
Private Sub CommandButton1_Click()
Dim i%, strFileName$, strDirectory$
strDirectory = "E:"
strFileName = Dir(strDirectory, vbDirectory)
Do While strFileName <> ""
If strFileName <> "." And strFileName <> ".." Then
If (GetAttr(strDirectory & strFileName) And vbDirectory) = vbDirectory Then
i = i + 1
Range("A" & i).Select
ActiveCell.FormulaR1C1 = strFileName
End If
End If
strFileName = Dir
Loop
End Sub
二、
VB code
Sub GetNo()
Selection.Find.ClearFormatting
Selection.Find.Replacement.ClearFormatting
Dim i As Long
For i = 1 To 10
With Selection.Find
.Text = "abc"
.Replacement.Text = i & ".abc"
.Forward = True
End With
With Selection
If .Find.Forward Then
.Collapse Direction:=wdCollapseStart
Else
.Collapse Direction:=wdCollapseEnd
End If
.Find.Execute Replace:=wdReplaceOne
If .Find.Forward Then
.Collapse Direction:=wdCollapseEnd
Else
.Collapse Direction:=wdCollapseStart
End If
.Find.Execute
End With
Next
End Sub
三、
C# code
private void webBrowser1_DocumentCompleted(object sender, WebBrowserDocumentCompletedEventArgs e)
{
HtmlElement btn = null;
HtmlDocument doc = webBrowser1.Document;
for (int i = 0; i < doc.All.Count; i++)
{
if (doc.All[i].TagName.ToUpper().Equals("INPUT"))
{
switch (doc.All[i].Name)
{
case "ctl00$rightCon$ProductQuery$AspNetPager1_input": //页码框
doc.All[i].InnerText = "2"; //页码赋值
break;
case "ctl00$rightCon$ProductQuery$AspNetPager1": //GO按钮
btn = doc.All[i];
break;
}
}
}
btn.InvokeMember("Click");//点击GO按钮
}
一、
VB code
Option Explicit
Sub main()
Dim strPath As String, strFile As String
Dim nRows As Long, nCols As Long, c As Long
Dim xlApp As Object, xlSrcBook As Object, xlNewBook As Object, xlSheet As Object, xlRange As Object
strPath = "c:\temp"
If Dir(strPath & "合并后的文件.xls") <> "" Then Kill strPath & "合并后的文件.xls"
Set xlApp = CreateObject("Excel.Application")
Set xlNewBook = xlApp.Workbooks.Add
strFile = Dir(strPath & "*.xls")
Do While Len(strFile) > 0
Set xlSrcBook = xlApp.Workbooks.Open(strPath & strFile, , True)
Set xlSheet = xlSrcBook.Sheets(1)
nRows = xlSheet.UsedRange.Rows.Count
nCols = xlSheet.UsedRange.Columns.Count
Set xlRange = xlSheet.Range(xlSheet.Cells(IIf(c, 2, 1), 1), xlSheet.Cells(nRows, nCols))
xlRange.Select
xlRange.Copy
xlNewBook.Sheets(1).Cells(c + 1, 1).PasteSpecial &HFFFFEFF8
c = xlNewBook.Sheets(1).UsedRange.Rows.Count
xlSrcBook.Close
strFile = Dir()
Loop
xlNewBook.SaveAs strPath & "合并后的文件.xls"
xlNewBook.Close
xlApp.Quit
MsgBox "文件数据合并完毕!", vbInformation, "提示"
End Sub
二、
VB code
Sub Fsyyyy_GetData()
With Sheets("sheet1")
arr = .Range("c2:e" & .[c65536].End(xlUp).Row)
p = ThisWorkbook.Path & "\零件报价"
Set xlsapp = CreateObject("excel.application")
xlsapp.Visible = False
For i = 1 To UBound(arr)
f = Dir(p & "*." & arr(i, 1) & ".xls", vbNormal)
If f <> "" Then
Set wbk = xlsapp.Workbooks.Open(p & f, 3)
With wbk.Sheets("sheet1")
arr(i, 3) = .Cells(.Cells.Find("报价合计(含税)", lookat:=xlWhole).Row, 5)
End With
wbk.Close False
Set wbk = Nothing
End If
Next
xlsapp.Quit
Set xlsapp = Nothing
.Range("c2:e" & .[c65536].End(xlUp).Row) = arr
End With
End Sub
三、
VB code
Sub SeperateSheet()
Dim strCriteria, FileName, i
Application.DisplayAlerts = False
strCriteria = Array("1", "2", "3")
For i = 0 To 2
With ActiveSheet.UsedRange
.AutoFilter Field:=1, Criteria1:=strCriteria(i)
FileName = ThisWorkbook.Path & "" & strCriteria(i) & ".xls"
On Error Resume Next
Application.DisplayAlerts = False
Kill FileName
Application.DisplayAlert = True
Set wk = Workbooks.Add
.SpecialCells(xlCellTypeVisible).Copy wk.ActiveSheet.[a1]
wk.SaveAs FileName:=FileName, FileFormat:=xlExcel8
wk.Close
End With
Next
ActiveSheet.UsedRange.AutoFilter
Application.DisplayAlerts = True
MsgBox "Done"
End Sub
四、
VB code
Sub 按钮1_Click()
Dim arr, brr
arr = Sheet1.Range("A1").CurrentRegion
ReDim brr(1 To UBound(arr), 0)
For i = 5 To UBound(arr) Step 5
If arr(i, 1) = arr(i, 2) Then b = b + 1: brr(b, 0) = i
Next
If b = 0 Then MsgBox "没有相同的数据！", , "": Exit Sub
With Sheet2
.Rows.Clear
.[a1] = "数据相同的行号"
.[a2].Resize(b, 1) = brr
.Select
End With
End Sub
五、
VB code
Sub test()
Dim arr, brr(1 To 10000, 1 To 4), i As Long, j As Byte, k As Long, L As Long
L = InputBox("请输入数据", "输入数据", "")
arr = Range("a1:d" & [a65536].End(xlUp).Row)
For i = 1 To UBound(arr)
If arr(i, 4) = L Then
k = k + 6
For j = 1 To 4
brr(k - 5, j) = arr(i - 3, j)
brr(k - 4, j) = arr(i - 2, j)
brr(k - 3, j) = arr(i - 1, j)
brr(k - 2, j) = arr(i, j)
brr(k - 1, j) = arr(i + 1, j)
brr(k, j) = arr(i + 2, j)
Next j
End If
Next i
[k1].Resize(k, 4) = brr
End Sub
[最优解释]
我还写第一个：
Private Sub CommandButton1_Click()
'搜索 E:\ 下的文件夹，并将文件夹名称列在 A 列
Dim i%, strFileName$, strDirectory$
strDirectory = "E:"
strFileName = Dir(strDirectory, vbDirectory) '搜索文件夹
Do While strFileName <> ""
If strFileName <> "." And strFileName <> ".." Then '不要 . .. 的文件夹
If (GetAttr(strDirectory & strFileName) And vbDirectory) = vbDirectory Then
i = i + 1
Range("A" & i).Select
ActiveCell.FormulaR1C1 = strFileName '文件夹名放入 A 列
End If
End If
strFileName = Dir
Loop
End Sub
Sub test()
'在表的第四列查找 L 的值，找到后从 L 所在行号的前三行开始，向下6行的数据全部追加到 K 列开始的区域
Dim arr, brr(1 To 10000, 1 To 4), i As Long, j As Byte, k As Long, L As Long
L = InputBox("请输入数据", "输入数据", "") '要找的值
arr = Range("a1:d" & [a65536].End(xlUp).Row) 'A-D 列全部的数值
For i = 1 To UBound(arr)
If arr(i, 4) = L Then '在第四列中查找
'找到后，从 i-3 行开始 到 i+2 行结束的24个单元格数据，放入数组 brr，k指针向下移6行，接收下一组数据
k = k + 6
For j = 1 To 4
brr(k - 5, j) = arr(i - 3, j)
brr(k - 4, j) = arr(i - 2, j)
brr(k - 3, j) = arr(i - 1, j)
brr(k - 2, j) = arr(i, j)
brr(k - 1, j) = arr(i + 1, j)
brr(k, j) = arr(i + 2, j)
Next j
End If
Next i
[k1].Resize(k, 4) = brr '得到的数据放在表的 K-N 列。
End Sub
