vba 怎么将单元格区域赋值给数组
Posted
tags:
篇首语:本文由小常识网(cha138.com)小编为大家整理,主要介绍了vba 怎么将单元格区域赋值给数组相关的知识,希望对你有一定的参考价值。
您好,我来为您解答:没有非常简便的办法,只能用循环一 一读入数组
只能循环写入
REDIM PRESERVE
希望我的回答对你有帮助。 参考技术A redim shuzu(100)
shuzu(i) = From!窗体名称!控件名称
这样就可以了啊! 参考技术B dim arr()
arr=range(“a3:f20”)
这样也行
如何将单元格区域作为表格从 Excel 复制到 PowerPoint - VBA
【中文标题】如何将单元格区域作为表格从 Excel 复制到 PowerPoint - VBA【英文标题】:How to copy cell range as table from Excel to PowerPoint - VBA 【发布时间】:2011-04-19 21:58:15 【问题描述】:我找不到任何方法来做到这一点。我现在拥有的是它将范围复制为图像:
Dim XLApp As Excel.Application
Dim PPSlide As Slide
Set XLApp = GetObject(, "Excel.Application")
XLApp.Range("A1:B17").Select
XLApp.Selection.CopyPicture Appearance:=xlScreen, Format:=xlPicture
PPSlide.Shapes.Paste.Select
这就像一个魅力,但是否有可能让它将范围复制为表格而不是图片?
【问题讨论】:
为什么同一个问题要问两次? 很抱歉,我无法使用发布最后一个问题的帐户登录,并且标记混乱。所以我认为最好用格式正确的代码再次询问。 【参考方案1】:好吧,如果我手动复制它,我可能会执行选择性粘贴并选择“格式化文本 (RTF)”作为类型。我相信你可以在 VBA 中模仿它。
编辑
啊,我们开始吧。在您的幻灯片中执行此操作:
-
转到插入->对象
选择您的 Excel 文件。检查链接选项。
您的 XL 文件的链接现已嵌入到您的 PP 文件中。当您的 XL 文件中的数据发生变化时,您可以:
-
通过右键单击->更新链接手动更新。
VBA 使用类似
ActivePresentation.UpdateLinks
的东西自动更新它
这是一种与您最初采用的方法截然不同的方法,但我相信它可以让您更接近您的目标。虽然它有它自己的问题,但这些都是可以解决的。
【讨论】:
我已经尝试过 PPSlide.Selection.PasteExcelTable - 但这不起作用。还有 PPSlide.Shapes.PasteExcelTable 。有任何想法吗?编辑:我无法在 powerpoint 中记录宏,但是当我尝试在 word 中执行并从 excel 中复制表格时,您建议我获取此代码:Selection.PasteAndFormat (wdTableOriginalFormatting) - 我可以在 powerpoint 中使用类似的东西吗vba 代码? 嗯,你为什么不能使用 PasteExcelTable 方法?你得到什么错误? 编译错误:找不到方法或数据成员是我尝试 PPSlide.Selection.PasteExcelTable 或 PPSlide.Shapes.PasteExcelTable 时遇到的错误。所以我猜语法不是很好吗? (一个小提示:VBA 有一个叫做 Intellisense 的功能,它可以为您提供可用方法/属性/等的列表。在 VBA 中,如果您输入“PPSlide”。您应该会看到一个下拉菜单该类成员的列表。如果您没有看到您要查找的内容,那么您做错了。在您设计以前从未做过的事情时非常有用) 见我上面的编辑。另一种方法。【参考方案2】:这可以简单地完成
Dim XLApp As Excel.Application
Dim PPSlide As Slide
Set XLApp = GetObject(, "Excel.Application")
XLApp.Range("A1:B17").Copy
PPSlide.Shapes.PasteSpecial DataType:=ppPasteOLEObject, Link:=msoFalse
【讨论】:
你能解释一下吗?我无法让这个宏工作。【参考方案3】:Sub abc()
j = 2
Sheets("sheet1").Select
ActiveSheet.Range("a1").Select
ActiveSheet.Range("a65536").Select
lastrow = Selection.End(xlUp).Row
'/// column a
ActiveSheet.Range("a3:a" & lastrow).Select
Application.CutCopyMode = False
Selection.AutoFilter
ActiveSheet.Range("$A$3:$A$" & lastrow).AutoFilter Field:=1, Criteria1:="="
Set Rng = ActiveSheet.AutoFilter.Range
cnt = Rng.Columns(1).SpecialCells(xlCellTypeVisible).Count - 1
If cnt = 0 Then
GoTo label1
End If
ActiveSheet.Range("a3:a" & lastrow - 1).Offset(1, 0).SpecialCells(xlCellTypeVisible).EntireRow.Copy
'Selection.EntireRow.Select
' Range(Selection, Selection.End(xlToRight)).Select
rownum = Selection.Row
' If rownum = 3 Then
' Selection.AutoFilter
' GoTo label1
' End If
'Selection.Copy
Sheets("Sheet2").Select
'lrow = ActiveSheet.Range("A65536").End(xlUp).Row
lrow = Cells.Find(what:="*", after:=[a1], searchorder:=xlByRows, _
searchdirection:=xlPrevious).Row
ActiveSheet.Range("a" & lrow + 1).Select
ActiveSheet.Paste
Sheets("Sheet1").Select
Selection.Offset(1, 0).SpecialCells(xlCellTypeVisible).Select
Selection.EntireRow.Delete
Application.CutCopyMode = False
label1:
Selection.AutoFilter
'column b///////////
ActiveSheet.Range("a65536").Select
lastrow = Selection.End(xlUp).Row
ActiveSheet.Range("b3:b" & lastrow).Select
Application.CutCopyMode = False
Selection.AutoFilter
ActiveSheet.Range("$b$3:$b$" & lastrow).AutoFilter Field:=1, Criteria1:="="
Set Rng = ActiveSheet.AutoFilter.Range
cnt = Rng.Columns(1).SpecialCells(xlCellTypeVisible).Count - 1
If cnt = 0 Then
GoTo label2
End If
ActiveSheet.Range("$b$3:$b$" & lastrow - 1).Offset(1, 0).SpecialCells(xlCellTypeVisible).EntireRow.Copy
'Range(Selection, Selection.End(xlToLeft)).Select
'
' Selection.EntireRow.Select
'Range(Selection, Selection.End(xlToRight)).Select
' rownum = Selection.Row
' If rownum = 3 Then
' Selection.AutoFilter
' GoTo label2
' End If
' Selection.Copy
Sheets("Sheet2").Select
'lrow = ActiveSheet.Range("A65536").End(xlUp).Row
lrow = Cells.Find(what:="*", after:=[a1], searchorder:=xlByRows, _
searchdirection:=xlPrevious).Row
ActiveSheet.Range("a" & lrow + 1).Select
ActiveSheet.Paste
Sheets("Sheet1").Select
'Selection.SpecialCells(xlCellTypeVisible).Select
'Selection.Offset(1, 0).SpecialCells(xlCellTypeVisible).Select
'
' Selection.EntireRow.Delete
ActiveSheet.Range("$b$3:$b$" & lastrow - 1).Offset(1, 0).SpecialCells(xlCellTypeVisible).EntireRow.Delete
Application.CutCopyMode = False
label2:
Selection.AutoFilter
'column c////////////
ActiveSheet.Range("c65536").Select
lastrow = Selection.End(xlUp).Row
ActiveSheet.Range("c3:c" & lastrow).Select
Application.CutCopyMode = False
Selection.AutoFilter
ActiveSheet.Range("$c$3:$c$" & lastrow).AutoFilter Field:=1, Criteria1:="SG Plus", _
Operator:=xlOr, Criteria2:="=Select"
Set Rng = ActiveSheet.AutoFilter.Range
cnt = Rng.Columns(1).SpecialCells(xlCellTypeVisible).Count - 1
If cnt = 0 Then
GoTo label3
End If
ActiveSheet.Range("$c$3:$c$" & lastrow - 1).Offset(1, 0).SpecialCells(xlCellTypeVisible).EntireRow.Copy
'Range(Selection, Selection.End(xlToRight)).Select
' Selection.Copy
' Sheets("Sheet2").Select
' lrow = activehseet.Range("A65536").End(xlUp).Row
' ActiveSheet.Range("a" & lrow).Select
' ActiveSheet.Paste
' Sheets("Sheet1").Select
' rownum = Selection.Row
' If rownum = 3 Then
' Selection.AutoFilter
' GoTo label3
' End If
' Range("a4:a" & lastrow).Select
' Range(Selection, Selection.End(xlToRight)).Select
' Selection.EntireRow.Select
' Selection.SpecialCells(xlCellTypeVisible).Select
ActiveSheet.Range("$c$3:$c$" & lastrow - 1).Offset(1, 0).SpecialCells(xlCellTypeVisible).EntireRow.Select
Selection.EntireRow.Delete
Application.CutCopyMode = False
label3:
Selection.AutoFilter
'column c again/////////////
ActiveSheet.Range("c65536").Select
lastrow = Selection.End(xlUp).Row
ActiveSheet.Range("c3:c" & lastrow).Select
Application.CutCopyMode = False
Selection.AutoFilter
ActiveSheet.Range("$c$3:$c$" & lastrow).AutoFilter Field:=1, Criteria1:="="
Set Rng = ActiveSheet.AutoFilter.Range
cnt = Rng.Columns(1).SpecialCells(xlCellTypeVisible).Count - 1
If cnt = 0 Then
GoTo label4
End If
ActiveSheet.Range("$c$3:$c$" & lastrow - 1).Offset(1, 0).SpecialCells(xlCellTypeVisible).EntireRow.Copy
' rownum = Selection.Row
' If rownum = 3 Then
' Selection.AutoFilter
' GoTo label4
' End If
'
' Range(Selection, Selection.End(xlToRight)).Select
'
' Range("a4:a" & lastrow).Select
' Range(Selection, Selection.End(xlToRight)).Select
'
' Selection.EntireRow.Copy
Sheets("Sheet2").Select
'lrow = ActiveSheet.Range("A65536").End(xlUp).Row
lrow = Cells.Find(what:="*", after:=[a1], searchorder:=xlByRows, _
searchdirection:=xlPrevious).Row
ActiveSheet.Range("a" & lrow + 1).Select
ActiveSheet.Paste
Sheets("Sheet1").Select
ActiveSheet.Range("$c$3:$c$" & lastrow - 1).Offset(1, 0).SpecialCells(xlCellTypeVisible).EntireRow.Select
' Selection.SpecialCells(xlCellTypeVisible).Select
Selection.EntireRow.Delete
Application.CutCopyMode = False
label4:
Selection.AutoFilter
'////////////////////////// over /////////////////////////////
ActiveSheet.Range("a1").Select
For i = 4 To lastrow
Range("a" & i).Select
If Range("a" & i).Value = "MidAmerica" Or Range("a" & i).Value = "Northeast" Or Range("a" & i).Value = "Southeast" Or _
Range("a" & i).Value = "West" Then
GoTo cont
Else
Rows(i).Select
Application.CutCopyMode = False
Selection.Cut
Sheets("Sheet2").Select
lrow = Cells.Find(what:="*", after:=[a1], searchorder:=xlByRows, _
searchdirection:=xlPrevious).Row
Range("a" & lrow + 1).Select
ActiveSheet.Paste
j = j + 1
Sheets("sheet1").Select
Selection.Delete Shift:=xlUp
End If
cont:
Next i
'/////// column b ///////////
ActiveSheet.Range("a1").Select
For i = 4 To lastrow
Range("b" & i).Select
If Range("b" & i).Value = "CA" Or Range("b" & i).Value = "AZ" Then
GoTo cont2
Else
Rows(i).Select
Application.CutCopyMode = False
Selection.Cut
Sheets("Sheet2").Select
lrow = Cells.Find(what:="*", after:=[a1], searchorder:=xlByRows, _
searchdirection:=xlPrevious).Row
Range("a" & lrow + 1).Select
ActiveSheet.Paste
j = j + 1
Sheets("sheet1").Select
Selection.Delete Shift:=xlUp
End If
cont2:
Next i
'///////////column c //////////
ActiveSheet.Range("a1").Select
For i = 4 To lastrow
Range("c" & i).Select
If Range("c" & i).Value = "SG" Then
GoTo cont3
Else
Rows(i).Select
Application.CutCopyMode = False
Selection.Cut
Sheets("Sheet2").Select
lrow = Cells.Find(what:="*", after:=[a1], searchorder:=xlByRows, _
searchdirection:=xlPrevious).Row
Range("a" & lrow + 1).Select
ActiveSheet.Paste
j = j + 1
Sheets("sheet1").Select
Selection.Delete Shift:=xlUp
End If
cont3:
Next i
'//////////column l/////////////
ActiveSheet.Range("a1").Select
For i = 4 To lastrow
Range("l" & i).Select
If Range("l" & i).Value <= "01/06/2014" And Range("l" & i).Value >= "01/01/2013" Then
GoTo cont4
Else
Rows(i).Select
Application.CutCopyMode = False
Selection.Cut
Sheets("Sheet2").Select
lrow = Cells.Find(what:="*", after:=[a1], searchorder:=xlByRows, _
searchdirection:=xlPrevious).Row
Range("a" & lrow + 1).Select
ActiveSheet.Paste
j = j + 1
Sheets("sheet1").Select
Selection.Delete Shift:=xlUp
End If
cont4:
Next i
'//////////column m/////////////
ActiveSheet.Range("a1").Select
For i = 4 To lastrow
Range("m" & i).Select
If Range("m" & i).Value = "12/01" Or Range("m" & i).Value = "12/05" Then
GoTo cont5
Else
Rows(i).Select
Application.CutCopyMode = False
Selection.Cut
Sheets("Sheet2").Select
lrow = Cells.Find(what:="*", after:=[a1], searchorder:=xlByRows, _
searchdirection:=xlPrevious).Row
Range("a" & lrow + 1).Select
ActiveSheet.Paste
j = j + 1
Sheets("sheet1").Select
Selection.Delete Shift:=xlUp
End If
cont5:
Next i
'//////////column q and r/////////////
ActiveSheet.Range("a1").Select
For i = 4 To lastrow
Range("q" & i).Select
If Range("q" & i).Value <> " " And Range("r" & i).Value <> " " And Range("u" & i).Value <> " " _
And Range("z" & i).Value <> " " And Range("aa" & i).Value <> " " And Range("ab" & i).Value <> " " _
And Range("b" & i).Value <> " " And Range("j" & i).Value <> " " Then
GoTo cont6
Else
Rows(i).Select
Application.CutCopyMode = False
Selection.Cut
Sheets("Sheet2").Select
lrow = Cells.Find(what:="*", after:=[a1], searchorder:=xlByRows, _
searchdirection:=xlPrevious).Row
Range("a" & lrow + 1).Select
ActiveSheet.Paste
j = j + 1
Sheets("sheet1").Select
Selection.Delete Shift:=xlUp
End If
cont6:
Next i
End Sub
【讨论】:
【参考方案4】:只需要自己解决这个问题。这是对我有用的特殊粘贴:
XLApp.Selection.Copy
PPSlide.Shapes.PasteSpecial DataType:=ppPasteDefault
我在这里找到了特殊粘贴选项的完整列表:
http://www.thespreadsheetguru.com/blog/2014/3/17/copy-paste-an-excel-range-into-powerpoint-with-vba
【讨论】:
【参考方案5】:上述建议的解决方案对我不起作用,因为 excel 表格继续作为(不可编辑的)图片粘贴到 powerpoint 中。
要在 powerpoint 的命令栏中直接运行 pastespecial 'Keep Source Formatting' 按钮,请运行以下代码:
Application.CommandBars.ExecuteMso ("PasteSourceFormatting")
Microsoft msdn 网站上的更多(但有限)信息:https://msdn.microsoft.com/en-us/library/office/ff862419.aspx
【讨论】:
以上是关于vba 怎么将单元格区域赋值给数组的主要内容,如果未能解决你的问题,请参考以下文章