'-------------------一覧取得-----------------------------
Sub getRedmineGrid_Click()
Dim wb As Workbook
Dim sheet As Worksheet
Dim path As String
path = ThisWorkbook.path & "\issues.xls"
If Dir(path) = "" Then
FileCopy ThisWorkbook.path & "\back\issues.xls", path
Else
FileCopy path, ThisWorkbook.path & "\back\issues.xls"
End If
Dim idx As Integer
idx = 11
Dim csvWb As Workbook
Set csvWb = Workbooks.Open(path)
Set wb = Workbooks("進捗.xlsm")
Set sheet = wb.Sheets("進捗")
sheet.Range("B" & idx & ":Z1000").ClearContents sheet.Range("D6") = Format(Date, "yyyymmdd")
For Each csvSheet In csvWb.Sheets
For i = 2 To 100
If csvSheet.Range("B" & i) = "" Then
Exit For
End If
If csvSheet.Range("B" & i) <> "#" Then
sheet.Range("B" & idx) = csvSheet.Range("B" & i)
sheet.Range("C" & idx) = csvSheet.Range("C" & i)
sheet.Range("D" & idx) = csvSheet.Range("D" & i)
sheet.Range("E" & idx) = csvSheet.Range("E" & i)
sheet.Range("F" & idx) = csvSheet.Range("F" & i)
sheet.Range("G" & idx) = csvSheet.Range("G" & i)
sheet.Range("H" & idx) = csvSheet.Range("H" & i)
sheet.Range("I" & idx) = csvSheet.Range("I" & i)
sheet.Range("J" & idx) = csvSheet.Range("J" & i) sheet.Hyperlinks.Add Anchor:=sheet.Range("B" & idx), Address:="https://XXXXX/" & CStr(sheet.Range("B" & idx))
idx = idx + 1
End If
Next
Next csvWb.Close
Kill path MsgBox "ファイルのデータ取得した。" End Sub '-------------------週状態取得-----------------------------
Sub getLateData_Click() Dim shetName As String
Dim sheet As Worksheet
Dim wb As Workbook
Dim sysDate As String
Dim maxRow As Integer
Dim sheetSample As Worksheet sysDate = Format(Date, "yyyymmdd")
'sysDate7Befor = Format(Date - 7, "yyyymmdd") Set wb = Workbooks("進捗.xlsm")
Set sheet = wb.Sheets("進捗")
Set sheetSample = wb.Sheets("sample")
sysDate7Befor = sheetSample.Range("D6")
shetName = "週(" & sysDate7Befor & "~" & sysDate & ")" maxRow = sheet.Cells.Find("*", , , , xlByRows, xlPrevious).Row
'Sheet1.Cells.Find("*", , , , xlByColumns, xlPrevious).colum If SheetIsExist(wb, shetName) Then Application.DisplayAlerts = False
wb.Sheets(shetName).Delete
Application.DisplayAlerts = True
End If wb.Sheets("sample").Copy after:=wb.Sheets("進捗")
ActiveSheet.Name = shetName
Dim sht As Worksheet
Set sht = wb.Sheets(shetName)
sht.Range("D6") = sysDate7Befor & "~" & sysDate Dim idx As Integer
Dim startRow As Integer
Dim rowColor As String idx = 11
startRow = idx - 3 For i = idx To maxRow
If sheet.Range("B" & i) = "" Then
Exit For
End If If Trim(sysDate7Befor) <= dateToStr(sheet.Range("H" & i)) And dateToStr(sheet.Range("H" & i)) <= sysDate Then
sht.Range("B" & idx) = sheet.Range("B" & i)
sht.Range("C" & idx) = sheet.Range("C" & i)
sht.Range("D" & idx) = sheet.Range("D" & i)
sht.Range("E" & idx) = sheet.Range("E" & i)
sht.Range("F" & idx) = sheet.Range("F" & i)
sht.Range("G" & idx) = sheet.Range("G" & i)
sht.Range("H" & idx) = sheet.Range("H" & i)
sht.Range("I" & idx) = sheet.Range("I" & i)
sht.Range("J" & idx) = sheet.Range("J" & i)
rowColor = ""
If sht.Range("D" & idx) = "終了" Then
rowColor = "back"
End If
Call addStyle(sht, idx, startRow, rowColor)
sht.Hyperlinks.Add Anchor:=sht.Range("B" & idx), Address:="https://XXXXX/" & CStr(sht.Range("B" & idx))
idx = idx + 1
End If
Next sheetSample.Range("D6") = sysDate
End Sub Function dateToStr(str As String)
dateToStr = ""
If str = "" Then
dateToStr = ""
Exit Function
End If
str = Replace(str, "-", "/")
dateToStr = Split(str, "/")(0) If Len(Split(str, "/")(1)) < 2 Then
dateToStr = dateToStr & "0" & Split(str, "/")(1)
Else
dateToStr = dateToStr & Split(str, "/")(1)
End If If Len(Split(str, "/")(2)) < 2 Then
dateToStr = dateToStr & "0" & Split(str, "/")(2)
Else
dateToStr = dateToStr & Split(str, "/")(2)
End If End Function Function SheetIsExist(wbCheck As Workbook, shtNm As String)
SheetIsExist = False
On Error GoTo lab1 Set shetSheet = wbCheck.Sheets(shtNm)
If shetSheet Is Nothing Then
SheetIsExist = False
Else
SheetIsExist = True
End If
Set shetSheet = Nothing
Exit Function lab1:
SheetIsExist = False
End Function

  

VBA实现打开Excel文件读取内容拷贝Format且加超链接的更多相关文章

  1. C# 打开TXT文件读取内容

    控制关键字,有些关键字发短信发不出来,比如(金融)需要转化为(金.融) 要求:读取敏感字的,并且替换掉 using : using System.Collections.Generic;using S ...

  2. C#中的Excel操作【1】——设置Excel单元格的内容,打开Excel文件的一种方式

    前言 作为项目管理大队中的一员,在公司里面接触最多的就是Excel文件了,所以一开始就想从Excel入手,学习简单的二次开发,开始自己的编程之路! 程序界面 功能说明 打开文件按钮,可以由使用者指定要 ...

  3. C#读取excel文件的内容(使用DataSet)

    C#读取Excel文件的内容,通过OLEDB来连接,关键是连接的路径,如:string strConn = "Provider=Microsoft.ACE.OLEDB.12.0;Data S ...

  4. 麦咖啡阻挡正常打开Excel文件

    双击打开Excel文件,提示如下图: Excel文件被麦咖啡做阻挡,无法正常打开 处理方案: 过一会儿还是出现此问题,干脆就把缓冲区保护给禁用掉

  5. VB中后台打开Excel文件实现代码

    某些时候需要打开Excel文件来获取或者写入数据,但又不希望跳出打开的Excel文件窗口,可以用下面的代码: Dim eb As New excel.Application, wb as excel. ...

  6. 如何在单独的窗口中打开 Excel 文件

    如何在单独的窗口中打开 Excel 文件 文章编号:087583     2012/11/1 18:45:29 故障现象: 如何在单独的窗口中打开 Excel 文件? 解决方案: 比较安全的方法就是直 ...

  7. 用PHPExcel类读取excel文件的内容

    这里对PHPExcel类不做介绍,有兴趣的朋友可以自己查阅资料 在classes文件夹下有个PHPExcel.php文件,这个文件是这个类库的主要入口文件,在用之前,要引入这个类 其他的类,在此类中会 ...

  8. 关于Npoi+excel文件读取,修改文件内容的处理方式

    因最近有需求场景,实现对文件的读写操作,又不单独生成新的文件,对于源文件的修改,做了一个简单实现,如下↓ // 要操作的excel文件路径 string fileName = Server.MapPa ...

  9. vba打开excel文件遍历sheet的名字和指定单元格的值

    今天项目上有个应用,获取指定Excel文件下的所有sheet的名称以及当前sheet中指定单元格的值,并把他们写到固定的sheet中去,看了下,文件比较多,而且每个文件sheet的个数比较多,也不一样 ...

随机推荐

  1. PostgreSQL 学习手册-模式Schema

    一个数据库包含一个或多个命名的模式,模式又包含表.模式还包含其它命名的对象,包括数据类型.函数,以及操作符.同一个对象名可以在不同的模式里使用而不会导致冲突: 比如,schema1和myschema都 ...

  2. svn diff 只显示文件名

    svn diff   --summarize

  3. Bacteria (Gym - 101911C)

    2018-2019 ACM-ICPC, NEERC, Southern Subregional Contest, Qualification Stage Bacteria Gym - 101911C ...

  4. redis基准性能测试

    1 测试目的 了解redis在不同情况下的性能表现,并分析其性能瓶颈,找出相应的解决方案. 2 redis基准测试概览 运行下列命令可以了解自己的redis服务器的基本性能指标. 通过loopback ...

  5. jQuery Cookie (内附 上百行的中文使用手册,与 所有的注释中文翻译)

    jQuery Cookie (内附 上百行的中文使用手册,与 所有的注释中文翻译) 博主亲自翻译. 大家多多捧场. 更多资源请点击"查看TA 的资源" .全场通通 2积分. htt ...

  6. Tcl循环语句

    for 开始 判断语句 变量自增(自检) 循环体 示例代码: for {set i 0} {$i<10} {incr i} { puts "I is: $i " } 运行结果 ...

  7. Mac 下反编译Android APK

    准备工作:安装ApkTool.dex2jar.JD-GUI 安装ApkTool 1.下载ApkTool.大家可以从 https://ibotpeaches.github.io/Apktool/inst ...

  8. CodeForces - 1189E Count Pairs(平方差)

    Count Pairs You are given a prime number pp, nn integers a1,a2,…,ana1,a2,…,an, and an integer kk. Fi ...

  9. case设计及验证:入口+页面+展示

    测试个性CB问题, 功能整体结构为:入口+页面+展示 总结: 1. 产品文档为主,其次是服务端接口返回.数据结构及字段值确认.结合实际场景检查是否有遗漏或不合理. 2. 以字段为维度,每个字段的检查点 ...

  10. -bash: netstat: 未找到命令

    [root@localhost ~]# netstat -lunpt -bash: netstat: 未找到命令 [root@localhost ~]# yum -y install net-tool ...