|
[广告] VBA代码宝 - VBA编程加强工具 · VBA代码随查随用 · 内置多项VBA编程加强工具 ★ 免费下载 ★ ★ 使用手册★
Sub merscore()
Dim strpath, strdir As String
Dim thwk, scwk As Workbook
Dim k, rc As Integer
With Application.FileDialog(msoFileDialogFolderPicker)
If .Show = -1 Then
strpath = .SelectedItems(1)
Else
MsgBox "请选择文件所在文件夹"
Exit Sub
End If
End With
k = 4
Set thwk = ThisWorkbook
strdir = Dir(strpath & "\" & "*.xls*")
Do While strdir <> ""
Set scwk = Workbooks.Open(strpath & "\" & strdir)
If scwk.Name <> thwk.Name Then
scwk.Activate
rc = Sheets("答题卡").Cells(Rows.Count, 3).End(3).Row
scwk.Sheets("答题卡").Range("c1:c" & rc).Select
Selection.Copy
thwk.Activate
Sheets("score").Cells(1, k).Select
ActiveSheet.Paste
k = k + 1
scwk.Close savechanges:=False
End If
strdir = Dir
Loop
End Sub
Sub hedui()
Call merscore
Dim i, j As Integer
For i = 3 To Cells(Rows.Count, 3).End(3).Row
For j = 3 To Cells(i, Columns.Count).End(xlToLeft).Column
If Cells(i, 3) <> Cells(i, j) Then
Cells(i, j).Interior.Color = vbRed
End If
Next j
Next i
End Sub
|
|