谁能帮我写段Excel VBA代码达到将表1上的数据统计到如表2格式中,在这里先感谢咯
要通过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
其实可以用数据透视表来做,也一样
代码 是下面的:
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名字告诉下
excel 怎么用宏写一段复制表1的指定单元格内容至表2最后一行空白处从指...
sub 宏代码()sheet1.range(指定范围如"a3:a10").copy sheet2.Range(指定列号如"a65536").end(3).offset(0,1).pastespecial Paste:=xlPasteValues end sub
帮忙在excel中写一段宏代码,使得A列中有某一个单元格内容为空时,隐藏这...
这代码执行全部的行,65536,会很久哦 For Each rw In ActiveSheet.Rows If Cells(rw.Row, 1) = "" Then Rows(rw.Row).Select Selection.EntireRow.Hidden = True End If Next rw 如果指定行数,比如1-20行:For R=1 to 20 If Cells(R, 1) = "" Then Rows(R).Select Selection....
帮忙写一段EXCEL表函数代码
没有标题怎么写公式呢,例如D列究竟是什么时候的年龄呢。此外,需求也不太明白。建议图片从第一行开始,保留每一个的标题的,而且把需要计算的标题也写出来来,内容空着,大家给你写了公式粘贴到对应列的第2行,然后下拉就可以了。
求写excel vba中的一段代码
图片就不更新了,只更新代码。Integer是整数型,范围:-32,768 到 32,767 Long 长整数型,范围:-2,147,483,648 到 2,147,483,647 把Dim i As Integer改为Dim i As Long即可。【下面的代码已更新】:Sub JiSuan() b = [A2] e = [B2] g = [C2] r = [D65536].End...
在EXCEL中怎么把一段长话写在一个单元格里面?
2、在EXCEL 2007里,进入:开始-对齐方式中,点击“自动换行”图标,即可将所选的单元格、行、列等被选中区域的所有单元格的内容完成自动换行功能;3、在完成了自动换行功能后,当所输入内容超过单元格的宽度后,系统会将内容自动换到新行中继续显示。4、输入完成后可以适当调整列的宽度,即可保证单元格...
请问EXCEL用VBA怎么写这段代码。自动向下合并空白单元格。
Sub SpecialMerge() Dim M As Long, N As Long Dim i As Long, j As Long Dim k1 As Long, k2 As Long Application.DisplayAlerts = False k1 = 1 k2 = 1 With Selection M = .Columns.Count N = .Rows.Count For j = 1 To M For i = 1 To...
excel,怎么用vba写段关于查找指定文件夹内的文件名,并将其提取值至表...
<> "") Then IsExistFile = fileName Else IsExistFile = "无"End If End Function 参数说明strDir为文件夹路径,fileName为文件名 使用示例:某个单元格输入=IsExistFile("E:\\doc",B2) 即可,若不存在返回无,存在返回B2中的文件名称。路径和文件名可以直接用字符串或引用某个单元格内容。
求帮写一段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 NextEnd Sub ...
excel表格的分段
首先要多说一句,小编用的是office2010版本的excel,所以有些步骤另一些版本可能会不适用。建议大家用office2010,因为有些快捷键是只有office可以用的。首先我们来看一下分段函数:用函数作出英语分数段得分析结果; (要求:分数段为60分以下,60~69,70~79,80~89,90~99,100) 以这道题为例。...
在Excel VBA写一段代码。根据当前单元格输入内容。提取数据列包含该单...
Sub parse_data()Dim lr As Long Dim ws As Worksheet Dim vcol, i As Integer Dim icol As Long Dim myarr As Variant Dim title As String Dim titlerow As Integer vcol = 1 Set ws = Sheets("Sheet1")lr = ws.Cells(ws.Rows.Count, vcol).End(xlUp).Row title = "A1:C1"ti...
愈黛痔速: 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....