ExcelHome技术论坛

 找回密码
 免费注册

QQ登录

只需一步,快速开始

   
高效办公必会的Office实战技巧 永久免费,网表让Excel秒变数据库 Excel服务器-会Excel,做管理系统 Excel Home精品图文教程库
Excel不给力? 何不试试FoxTable! 国内首部Excel函数公式学习大典 职场充电黑科技, Office微视频教程 免费下载Excel行业应用视频
300集Office 2010微视频教程 Tableau-数据可视化工具 突破Excel限制,用活字格提高效率 12门Excel免费公开课任你学
你的Excel 2010实战技巧学习锦囊 欲罢不能, 过目难忘的 Office 新界面 免费的Excel考勤计算系统
查看: 139|回复: 6

单元格区域整理成一列(赋值给数组问题)在线等。谢谢

[复制链接]

TA的精华主题

TA的得分主题

发表于 2017-8-13 08:25 | 显示全部楼层 |阅读模式
要把rg2(红色单元格区域)的61个时间、以及该时间对应的员工编号、 员工姓名、 签卡日期 整理到sheets(1)的各列,
形成一个缺卡记录。
这个单元格区域处理不了,请各位大侠帮助。谢谢!!!!

在线等。谢谢 谢谢谢谢谢谢谢谢谢谢


Sub qianka()
Sheets.Add.Move Before:=ActiveSheet

Sheets(2).Select
Dim rg, rg2 As Range
Dim cishu, i As Integer

Set rg2 = ActiveSheet.Range(Cells(1, 8), Cells(Range("A1").CurrentRegion.Rows.Count, 11)).SpecialCells(xlCellTypeBlanks)
cishu = rg2.Cells.Count
    With rg2.Interior
        .Pattern = xlSolid
        .PatternColorIndex = xlAutomatic
        .ThemeColor = xlThemeColorAccent6
        .TintAndShade = 0.599993896298105
        .PatternTintAndShade = 0
    End With

For Each rg In rg2
  If rg.Column = 8 Then rg.Value = "08:30:00"
  
  If rg.Column = 9 Then rg.Value = "12:00:00"
     
  If rg.Column = 10 Then rg.Value = "13:30:00"
   
  If rg.Column = 11 Then rg.Value = "18:00:00"
Next



'     Dim cel, rg_1 As Range
'     Dim arr() As Variant
'     Dim n As Integer
'
'
'    arr() = rg2.Value
'
'     For n = 0 To cishu
'         ReDim Preserve arr(n)
'         arr(n) = rg2  '从大到小写入数组
'    Next
'    Next
'
'     k = 0
'     For Each cel In Range(Cells(2, 4), Cells(cishu + 1, 4))
'         cel = arr(k)  '数组赋值到单元格
'        k = k + 1
'     Next cel
'
'
'
'rg2.Select
'
'Set rg2 = Selection
'
'Dim arr
'
'Set arr = rg2
'
'
'ActiveSheet.Range(Cells(2, 4), Cells(cishu + 1, 4)).Value = arr.Value
'
'
For i = 1 To cishu
Sheets(1).Cells(i + 1, 1) = Cells(rg2.Cells(i).Row, 1).Value
Sheets(1).Cells(i + 1, 2) = Cells(rg2.Cells(i).Row, 2).Value
Sheets(1).Cells(i + 1, 3) = Cells(rg2.Cells(i).Row, 4).Value
Sheets(1).Cells(i + 1, 4) = rg2.Value
Sheets(1).Cells(i + 1, 5).Value = "正常签卡"
Next i



Sheets(1).[A1:F1] = Array("员工编号", "员工姓名", "签卡日期", "时间", "签卡类型", "事由")
   With Sheets(1).Range("A1:F1")
        .HorizontalAlignment = xlCenter
        .VerticalAlignment = xlCenter
        .WrapText = False
        .Orientation = 0
        .AddIndent = False
        .IndentLevel = 0
        .ShrinkToFit = False
        .ReadingOrder = xlContext
        .MergeCells = False
       .Interior.Pattern = xlSolid
       .Interior.PatternColorIndex = xlAutomatic
       .Interior.ThemeColor = xlThemeColorLight2
       .Interior.TintAndShade = 0.799981688894314
       .Interior.PatternTintAndShade = 0
    End With


End Sub

签卡.rar

13.84 KB, 下载次数: 0

TA的精华主题

TA的得分主题

 楼主| 发表于 2017-8-13 10:03 | 显示全部楼层
解决了单元格区域时间整理问题。但时间对应的其他列问题没有解决。
大神在哪儿?谢谢谢谢



Sub qianka()
Sheets.Add.Move Before:=ActiveSheet

Sheets(2).Select
Dim rg, rg2 As Range
Dim cishu, i As Integer

Set rg2 = ActiveSheet.Range(Cells(1, 8), Cells(Range("A1").CurrentRegion.Rows.Count, 11)).SpecialCells(xlCellTypeBlanks)
cishu = rg2.Cells.Count
    With rg2.Interior
        .Pattern = xlSolid
        .PatternColorIndex = xlAutomatic
        .ThemeColor = xlThemeColorAccent6
        .TintAndShade = 0.599993896298105
        .PatternTintAndShade = 0
    End With

For Each rg In rg2
  If rg.Column = 8 Then rg.Value = "08:30:00"
  
  If rg.Column = 9 Then rg.Value = "12:00:00"
     
  If rg.Column = 10 Then rg.Value = "13:30:00"
   
  If rg.Column = 11 Then rg.Value = "18:00:00"
Next

    Dim DataRange, cel As Range
    Dim brr(), num(), nam(), dat(), leix()
    Dim n As Long
   

   
    Dim num1, nam1, dat1, leix1 As Range
   
'   Set num1 = Cells(cel.Row, 1)
'   Set nam1 = Cells(cel.Row, 2)
'   Set dat1 = Cells(cel.Row, 4)
  ' Set leix1 = "正常签卡"
   
   
    For Each cel In rg2
        n = n + 1
        ReDim Preserve brr(1 To n)
        brr(n) = cel.Value

        
        
'        num(n) = num1.Value
'        nam(n) = nam1.Value
'        dat(n) = dat1.Value
'     '   leix(n) = "正常签卡"
     
    Next
'     Sheets(1).[a2].Resize(UBound(brr)) = Application.Transpose(num)
'     Sheets(1).[b2].Resize(UBound(brr)) = Application.Transpose(nam)
'     Sheets(1).[c2].Resize(UBound(brr)) = Application.Transpose(dat)
    Sheets(1).[d2].Resize(UBound(brr)) = Application.Transpose(brr)
'
'     Sheets(1).[e2].Resize(UBound(brr)) = Application.Transpose(leix)


Sheets(1).[A1:F1] = Array("员工编号", "员工姓名", "签卡日期", "时间", "签卡类型", "事由")
   With Sheets(1).Range("A1:F1")
        .HorizontalAlignment = xlCenter
        .VerticalAlignment = xlCenter
        .WrapText = False
        .Orientation = 0
        .AddIndent = False
        .IndentLevel = 0
        .ShrinkToFit = False
        .ReadingOrder = xlContext
        .MergeCells = False
       .Interior.Pattern = xlSolid
       .Interior.PatternColorIndex = xlAutomatic
       .Interior.ThemeColor = xlThemeColorLight2
       .Interior.TintAndShade = 0.799981688894314
       .Interior.PatternTintAndShade = 0
    End With
Sheets(1).Columns("D:D").NumberFormatLocal = "[$-F400]h:mm:ss AM/PM"

End Sub

签卡new.rar

16 KB, 下载次数: 0

解决了时间问题

TA的精华主题

TA的得分主题

 楼主| 发表于 2017-8-13 10:12 | 显示全部楼层

如下黑体 代码  解决了单元格区域时间的问题,但时间对应的其他列如何解决?

求大神。谢谢 谢谢  谢谢




Sub qianka()
Sheets.Add.Move Before:=ActiveSheet

Sheets(2).Select
Dim rg, rg2 As Range
Dim cishu, i As Integer

Set rg2 = ActiveSheet.Range(Cells(1, 8), Cells(Range("A1").CurrentRegion.Rows.Count, 11)).SpecialCells(xlCellTypeBlanks)
cishu = rg2.Cells.Count
    With rg2.Interior
        .Pattern = xlSolid
        .PatternColorIndex = xlAutomatic
        .ThemeColor = xlThemeColorAccent6
        .TintAndShade = 0.599993896298105
        .PatternTintAndShade = 0
    End With

For Each rg In rg2
  If rg.Column = 8 Then rg.Value = "08:30:00"
  
  If rg.Column = 9 Then rg.Value = "12:00:00"
     
  If rg.Column = 10 Then rg.Value = "13:30:00"
   
  If rg.Column = 11 Then rg.Value = "18:00:00"
Next

    Dim DataRange, cel As Range
    Dim brr(), num(), nam(), dat(), leix()
    Dim n As Long
   
'    Set DataRange = rg2
   
    Dim num1, nam1, dat1, leix1 As Range
   
'   Set num1 = Cells(cel.Row, 1)
'   Set nam1 = Cells(cel.Row, 2)
'   Set dat1 = Cells(cel.Row, 4)
  ' Set leix1 = "正常签卡"
   
   
    For Each cel In rg2
        n = n + 1
        ReDim Preserve brr(1 To n)
        brr(n) = cel.Value

        
        
'        num(n) = num1.Value
'        nam(n) = nam1.Value
'        dat(n) = dat1.Value
'     '   leix(n) = "正常签卡"
     
    Next
'     Sheets(1).[a2].Resize(UBound(brr)) = Application.Transpose(num)
'     Sheets(1).[b2].Resize(UBound(brr)) = Application.Transpose(nam)
'     Sheets(1).[c2].Resize(UBound(brr)) = Application.Transpose(dat)
     Sheets(1).[d2].Resize(UBound(brr)) = Application.Transpose(brr)
'
'     Sheets(1).[e2].Resize(UBound(brr)) = Application.Transpose(leix)


Sheets(1).[A1:F1] = Array("员工编号", "员工姓名", "签卡日期", "时间", "签卡类型", "事由")
   With Sheets(1).Range("A1:F1")
        .HorizontalAlignment = xlCenter
        .VerticalAlignment = xlCenter
        .WrapText = False
        .Orientation = 0
        .AddIndent = False
        .IndentLevel = 0
        .ShrinkToFit = False
        .ReadingOrder = xlContext
        .MergeCells = False
       .Interior.Pattern = xlSolid
       .Interior.PatternColorIndex = xlAutomatic
       .Interior.ThemeColor = xlThemeColorLight2
       .Interior.TintAndShade = 0.799981688894314
       .Interior.PatternTintAndShade = 0
    End With
Sheets(1).Columns("D:D").NumberFormatLocal = "[$-F400]h:mm:ss AM/PM"

End Sub

签卡new.rar

12.19 KB, 下载次数: 0

TA的精华主题

TA的得分主题

 楼主| 发表于 2017-8-13 10:17 | 显示全部楼层
这个帖子有用

如何将任意选定区域的单元格数据赋值于一个动态数组
http://club.excelhome.net/thread-880871-1-1.html
(出处: ExcelHome技术论坛)

TA的精华主题

TA的得分主题

 楼主| 发表于 2017-8-13 10:26 来自手机 | 显示全部楼层
怎么取这个数组对应的单元格区域各单元格的行号列号?

TA的精华主题

TA的得分主题

 楼主| 发表于 2017-8-13 12:28 来自手机 | 显示全部楼层
如何把区域rg2每个单元格对应的工号、姓名、日期分别生成新的数组是关键。有了这个数组后可以赋值给sheets(1)的相应列。求大神帮忙。谢谢谢谢

TA的精华主题

TA的得分主题

 楼主| 发表于 2017-8-13 15:59 | 显示全部楼层
自己完美解决!!!谢谢





Sub qianka()
Sheets.Add.Move Before:=ActiveSheet
Sheets(2).Select
Dim rg, rg2 As Range
Dim cishu, i As Integer
Dim n As Long
Dim brr(), num(), nam(), dat()
Set rg2 = ActiveSheet.Range(Cells(1, 8), Cells(Range("A1").CurrentRegion.Rows.Count, 11)).SpecialCells(xlCellTypeBlanks)
cishu = rg2.Cells.Count
    With rg2.Interior
        .Pattern = xlSolid
        .PatternColorIndex = xlAutomatic
        .ThemeColor = xlThemeColorAccent6
        .TintAndShade = 0.599993896298105
        .PatternTintAndShade = 0
    End With

For Each rg In rg2
  If rg.Column = 8 Then rg.Value = "08:30:00"
  If rg.Column = 9 Then rg.Value = "12:00:00"
  If rg.Column = 10 Then rg.Value = "13:30:00"
  If rg.Column = 11 Then rg.Value = "18:00:00"
  
  
   n = n + 1
  
        
        ReDim Preserve num(1 To n)
           num(n) = Cells(rg.Row, 1).Value
   
        ReDim Preserve nam(1 To n)
          nam(n) = Cells(rg.Row, 2).Value
        
        ReDim Preserve dat(1 To n)
          dat(n) = Cells(rg.Row, 4).Value
        
        ReDim Preserve brr(1 To n)
          brr(n) = rg.Value

         
Next

Sheets(1).[a2].Resize(UBound(brr)) = Application.Transpose(num)
Sheets(1).[b2].Resize(UBound(brr)) = Application.Transpose(nam)
Sheets(1).[c2].Resize(UBound(brr)) = Application.Transpose(dat)

Sheets(1).[d2].Resize(UBound(brr)) = Application.Transpose(brr)
Sheets(1).[e2].Resize(UBound(brr)) = "正常签卡"
   
Sheets(1).[A1:F1] = Array("员工编号", "员工姓名", "签卡日期", "时间", "签卡类型", "事由")
   With Sheets(1).Range("A1:F1")
        .HorizontalAlignment = xlCenter
        .VerticalAlignment = xlCenter
        .WrapText = False
        .Orientation = 0
        .AddIndent = False
        .IndentLevel = 0
        .ShrinkToFit = False
        .ReadingOrder = xlContext
        .MergeCells = False
       .Interior.Pattern = xlSolid
       .Interior.PatternColorIndex = xlAutomatic
       .Interior.ThemeColor = xlThemeColorLight2
       .Interior.TintAndShade = 0.799981688894314
       .Interior.PatternTintAndShade = 0
    End With
Sheets(1).Columns("D:D").NumberFormatLocal = "[$-F400]h:mm:ss AM/PM"
Sheets(1).Columns("C:C").NumberFormatLocal = "yyyy-m-d"

End Sub



签卡newnew.rar

11.49 KB, 下载次数: 0

解决

您需要登录后才可以回帖 登录 | 免费注册

本版积分规则

关闭

最新热点上一条 /1 下一条

关注官方微信,每天坐享新鲜教程

手机版|关于我们|联系我们|ExcelHome   

GMT+8, 2017-12-18 11:07 , Processed in 1.101030 second(s), 24 queries , Gzip On.

Powered by Discuz! X3.3

© 2001-2017 Wooffice Inc.

   

沪公网安备 31011702000001号 沪ICP备11019229号

本论坛言论纯属发表者个人意见,任何违反国家相关法律的言论,本站将协助国家相关部门追究发言者责任!     本站特聘法律顾问:徐怀玉律师 李志群律师

快速回复 返回顶部 返回列表