Question

EXCEL的 代码问题 请大侠们帮帮忙

这是表1

这是表2
我想再表1填入姓名 电话号码 年龄这些数据后 按旁边的保存，表1的信息自动栓除并自动保存到表2里面。
如果输入下一个人信息又保存在表2的下一行..表2 就依次往下保存。请大侠们帮帮忙 谢谢了..
表1和表2 是两个EXCEL表





Answer 1

Sub CommandButton1_Click()
Dim i As Integer
i = [a65536].End(xlUp).Row
i = IIf([a65536].End(xlUp) <> "", i + 1, i)
With workbooks("表2").workSheets("sheet1")
If Range("a1") = "" Or Application.WorksheetFunction.CountA(Range("b2:b4")) <> 3 Or Range("d2") = "" Or Range("d3") = "" Then
MsgBox "有未填写的信息，请完善！"
Else
.Range("a" & i) = Range("a1").Value
.Range("b" & i) = Range("b2").Value
.Range("c" & i) = Range("b3").Value
.Range("d" & i) = Range("d2").Value
.Range("e" & i) = Range("d3").Value
.Range("f" & i) = Range("b4").Value
End If
Range("b2").Select
Range("b2:b4").Cells.Clear
Range("d2:d3").Cells.Clear
End With
End Sub

我写的代码最不简洁。。。哎。有待提高啊。

Answer 2

Private Sub CommandButton1_Click()

Dim n As Integer
n = Sheet2.Range("A65536").End(xlUp).Row + 1
Sheet2.Cells(n, 1) = Range("A1")
Sheet2.Cells(n, 2) = Range("B2")
Sheet2.Cells(n, 3) = Range("B3")
Sheet2.Cells(n, 4) = Range("D2")
Sheet2.Cells(n, 5) = Range("D3")
Sheet2.Cells(n, 6) = Range("B4")
Range("A1").ClearContents
Range("B2:B4").ClearContents
Range("D2:D3").ClearContents

End Sub

追问

能不能保存到 E:\2013\源表.xls 这个工作薄里面呢 我想登记用一个工作薄 记录用另外一个工作薄，如果我以后还想加很多的选项进去呢

追答

可以的,改一下
Private Sub CommandButton1_Click()
Dim n As Integer
Dim x As Integer
For x = 1 To Workbooks.Count
If Workbooks(x).Name = "源表.xls" Then
Workbooks("源表.xls").Save
Workbooks("源表.xls").Close
End If
Next
Workbooks.Open "E:\2013\源表.xls"
With Workbooks("源表.xls").Worksheets(1)
n = .Range("A65536").End(xlUp).Row + 1
.Cells(n, 1) = Range("A1")
.Cells(n, 2) = Range("B2")
.Cells(n, 3) = Range("B3")
.Cells(n, 4) = Range("D2")
.Cells(n, 5) = Range("D3")
.Cells(n, 6) = Range("B4")
'在这里添加需要增加的项目
End With
Workbooks("源表.xls").Save
Workbooks("源表.xls").Close
Range("A1").ClearContents
Range("B2:B4").ClearContents
Range("D2:D3").ClearContents
End Sub

如果你要加更多项目就根据哪个单元格加到哪个单元格自己添加就行了

Answer 3

Private Sub CommandButton1_Click()
Dim R As Long
R = .Range("a65536").End(xlUp).Row
With Workbooks("book2").Worksheets("sheet1")
.Range("a" & R).Value = Range("a1")
.Range("b" & R).Value = Range("b2")
.Range("c" & R).Value = Range("b3")
.Range("d" & R).Value = Range("d2")
.Range("e" & R).Value = Range("d3")
.Range("f" & R).Value = Range("b4")
End With
End Sub

Answer 4

Private Sub CommandButton1_Click()
With ActiveWorkbook.Worksheets("表2")
.Range("A65536").End(xlUp).Offset(1, 1).Value = Range("B2").Value
.Range("A65536").End(xlUp).Offset(1, 2).Value = Range("B3").Value
.Range("A65536").End(xlUp).Offset(1, 3).Value = Range("D2").Value
.Range("A65536").End(xlUp).Offset(1, 4).Value = Range("D3").Value
.Range("A65536").End(xlUp).Offset(1, 5).Value = Range("B4").Value
.Range("A65536").End(xlUp).Offset(1, 0).Value = Range("A1").Value
End With
End Sub

Answer 5

Private Sub CommandButton1_Click()
Dim mStr, mArr(5), i%
mStr = "a1,b2,b3,d2,d3,b4"
For i = 0 To 5
mArr(i) = Range(Split(mStr, ",")(i)).Value
Range(Split(mStr, ",")(i)) = ""
Next
Sheet2.Cells(Sheet2.[a65537].End(3).Row + 1, 1).Resize(1, 5) = mArr
Erase mArr
End Sub

追问

运行的时候说  引用无效

追答

把sheet2改了，两个都改成
worksheets("XX")
其中XX是你第二个工作表的名字