谁能帮我写段Excel VBA代码达到将表1上的数据统计到如表2格式中，在这里先感谢咯

excel 如何通过vba将sheet1中的操作写入到sheet2中~

要通过VBA把Sheet1工作表中的数据写入Sheet2工作表中，可以采用如下方法：
1、假如要把Sheet1工作表中A1单元格的数据写入Sheet2工作表的A1单元格中。
2、可以执行以下语句：
sub test() sheets("Sheet2").range("A1").Value=sheets("Sheet1").range("A1").Valueend sub3、语句解释：range("A1")代表A1单元格，.Value代表是单元格的值属性。

新建一个工作表，命名后保存到和与合并的100个文件同一个文件文件夹，摁 alt + f11,双击工程资源管理器里面的sheet1(sheet1),在右侧的代码区粘贴如下代码。运行。等候一会就OK了。

Sub 合并当前目录下所有工作簿的全部工作表()
Dim MyPath, MyName, AWbName
Dim Wb As Workbook, WbN As String
Dim G As Long
Dim Num As Long
Dim BOX As String
Application.ScreenUpdating = False
MyPath = ActiveWorkbook.Path
MyName = Dir(MyPath & "\" & "*.xls")
AWbName = ActiveWorkbook.Name
Num = 0
Do While MyName ""
If MyName AWbName Then
Set Wb = Workbooks.Open(MyPath & "\" & MyName)
Num = Num + 1
With Workbooks(1).ActiveSheet
.Cells(.Range("A65536").End(xlUp).Row + 2, 1) = Left(MyName, Len(MyName) - 4)
For G = 1 To Sheets.Count
Wb.Sheets(G).UsedRange.Copy .Cells(.Range("A65536").End(xlUp).Row + 1, 1)
Next
WbN = WbN & Chr(13) & Wb.Name
Wb.Close False
End With
End If
MyName = Dir
Loop
Range("A1").Select
Application.ScreenUpdating = True
MsgBox "共合并了" & Num & "个工作薄下的全部工作表。如下：" & Chr(13) & WbN, vbInformation, "提示"
End Sub

表1 的标题行，要放在 第一行
其实可以用数据透视表来做，也一样
代码 是下面的：
Sub 统计()
Dim d1 As Object, d2 As Object, d3 As Object, rng As Range, arr, arr1
Set d1 = CreateObject("Scripting.Dictionary")
Set d2 = CreateObject("Scripting.Dictionary")
Set d3 = CreateObject("Scripting.Dictionary")
Application.ScreenUpdating = False
On Error Resume Next
Worksheets("表1").Select
arr = Range("A1").CurrentRegion
n = UBound(arr, 2)
For i = 2 To UBound(arr)
d1(arr(i, 1)) = ""
d2(arr(i, 2)) = ""
For j = 3 To n
d3(arr(i, 1) & arr(i, 2) & arr(1, j)) = d3(arr(i, 1) & arr(i, 2) & arr(1, j)) + arr(i, j)
Next j
Next i
Set rng = Range(Cells(1, 1), Cells(1, UBound(arr, 2)))
Worksheets("表2").Select
Cells.Clear
arr1 = d1.Keys
For i = 0 To d1.Count - 1
Cells(i * n + 1, "A").Resize(UBound(arr, 2), 1) = Application.Transpose(rng)
Cells(i * n + 2, "B").Resize(1, d2.Count) = d2.Keys
Cells(i * n + 1, "B") = arr1(i)
For j = 1 To d2.Count
For k = 3 To n
Cells(i * n + k, 1 + j) = d3(arr1(i) & Cells(i * n + 3, 1 + j).Offset(-1, 0) & Cells(i * n + k, 1))
Next k
Next j
Next i
Application.ScreenUpdating = True
End Sub

不用vba，直接用公式就好了
1月
苹果销售 =SUMIFS(Sheet1!C2:C7,Sheet1!A2:A7,"A",Sheet1!B2:B7,"1")
橘子销售 = =SUMIFS(Sheet1!D2:D7,Sheet1!A2:A7,"A",Sheet1!B2:B7,"1")

如2月，直接把公式内最后的1换成2就好了

在EXCEL2007及以上版本：

=SUMIFS($C$3:$C$8,$A$3:$A$8,$G$4,$B$3:$B$8,G$5)

看图

Sheet名字告诉下

---

玉龙纳西族自治县19731665449： Excel求帮写一条vba代码 - ？
愈黛痔速： Sub tt() Dim Col As Integer With Sheets(＂sheet2＂) Col = .Rows(1).Find(Sheets(＂sheet1＂).Range(＂b1＂).Value, , , xlWhole).Column .Cells(3, Col).Resize(9, 5) = Sheets(＂sheet1＂).Range(＂b3:f11＂) End With Sheets(＂sheet1＂).Range(＂b3:f11＂).ClearContents End Sub

玉龙纳西族自治县19731665449： 哪位大神来给个vba代码 Excel的 - ？
愈黛痔速： 可以不用VBA,首先用X表示Y,把原式改成一个关于Y的X表达式.1. A列从A3开始输入序号数1、2、3....(X).2. B列从B3开始写入公式:=X的表达式(Y).3. 判断B列是否为正整数.如是,与对应的A列数就是所求的解.

玉龙纳西族自治县19731665449： 求一段excel vba循环代码 - ？
愈黛痔速： Sub FontFormat() Dim rngSelect As Range Set rngSelect = Worksheets(＂Sheet1＂).Range(＂A1:G10＂)For Each Cell In rngSelectWith Cell.Characters(Start:=8, Length:=1).Font.Name = ＂宋体＂.FontStyle = ＂常规＂.Size = 16End WithNext End Sub代码基本上是这样的,可以根据你的需要修改一下.

玉龙纳西族自治县19731665449： 求帮写一段vba代码,在excel文件中自动插入缺序号的空行,补全序号 - ？
愈黛痔速： Sub 插入行() For i = [a65536].End(3).Row To 2 Step -1 If Cells(i, 1) - 1 <> Cells(i - 1, 1) Then Rows(i & ＂:＂ & i).Insert Shift:=xlDown Cells(i, 1) = Cells(i + 1, 1) - 1 End If Next End Sub

玉龙纳西族自治县19731665449： 请EXCEL高人写一段VBA代码,让一个表只能在一定的日期内和次数内才能继续下面的VBA代码. - ？
愈黛痔速： 邮件已发送,请查收!(有实例文件,请打开修改测试) 代码介绍:1、在ThisWorkBook内输入下面代码:Option Explicit Private Sub Workbook_Open() If jiaoyan = False Then Exit Sub'请在下面输入继续运行的代码!MsgBox ＂你好,欢迎继续...

玉龙纳西族自治县19731665449： 写一段 excel vba 代码 - ？
愈黛痔速： 你的附图好像不对.假设是否锁定这列在“K”列,那么请按ALT+F11打开VBA窗口,粘贴以下代码:Private Sub Worksheet_SelectionChange(ByVal Target As Range) If Range(＂K＂ & Target.Row).Value = ＂是＂ Then ActiveSheet.Unprotect ...

玉龙纳西族自治县19731665449： 请高手帮忙写个excel vba程序~？
愈黛痔速： VBA可以实现,我也可以给你编一个.但是,我的原则是,如果Excel自带的公式和功能可以实现,绝不用VBA——它也有很大的局限性,甚至是危害性. 下面给出的方法,只是用VLOOKUP函数和条件格式就可以完成: 假设两个表格在一个工...

玉龙纳西族自治县19731665449： 请教excel 中的一段vba代码 - ？
愈黛痔速： sub test ()dim arr,brr,x&,y&arr=sheet1.usedrange '把原数据赋值给数组arrredim brr(1 to ubound(arr)*10,1 to ubound(arr,2))'定义一个数组行数是arr的10倍for x=1 to ubound(arr)...

玉龙纳西族自治县19731665449： 编写一个VBA程序代码 - ？
愈黛痔速： Sub 分页打印() x = InputBox(＂请输入打印起始页码＂) '设置打印起始页码 y = InputBox(＂请输入打印结束页码＂) '设置打印结束页码 For i = x To y '设置一个循环 Cells(7, 1) = 19 * (i - 1) + 1 '在A3单元格中输入一个序号 ActiveWindow.SelectedSheets.PrintOut '执行一次打印操作 Next '进入下一个循环 End Sub

玉龙纳西族自治县19731665449： 求一段vba代码,很简单,但实用 - ？
愈黛痔速： Sub BeFile()Set fs = CreateObject(＂Scripting.FileSystemObject＂)'Set a = fs.CreateTextFile(＂C:\a.txt＂, True)If fs.FileExists(＂C:\a.txt＂) = False ThenDim strPath As StringstrPath = Application.ActiveWorkbook.FullNameApplication....