VBA实现打开Excel文件读取内容拷贝Format且加超链接
'-------------------一覧取得-----------------------------
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且加超链接的更多相关文章
- C# 打开TXT文件读取内容
控制关键字,有些关键字发短信发不出来,比如(金融)需要转化为(金.融) 要求:读取敏感字的,并且替换掉 using : using System.Collections.Generic;using S ...
- C#中的Excel操作【1】——设置Excel单元格的内容,打开Excel文件的一种方式
前言 作为项目管理大队中的一员,在公司里面接触最多的就是Excel文件了,所以一开始就想从Excel入手,学习简单的二次开发,开始自己的编程之路! 程序界面 功能说明 打开文件按钮,可以由使用者指定要 ...
- C#读取excel文件的内容(使用DataSet)
C#读取Excel文件的内容,通过OLEDB来连接,关键是连接的路径,如:string strConn = "Provider=Microsoft.ACE.OLEDB.12.0;Data S ...
- 麦咖啡阻挡正常打开Excel文件
双击打开Excel文件,提示如下图: Excel文件被麦咖啡做阻挡,无法正常打开 处理方案: 过一会儿还是出现此问题,干脆就把缓冲区保护给禁用掉
- VB中后台打开Excel文件实现代码
某些时候需要打开Excel文件来获取或者写入数据,但又不希望跳出打开的Excel文件窗口,可以用下面的代码: Dim eb As New excel.Application, wb as excel. ...
- 如何在单独的窗口中打开 Excel 文件
如何在单独的窗口中打开 Excel 文件 文章编号:087583 2012/11/1 18:45:29 故障现象: 如何在单独的窗口中打开 Excel 文件? 解决方案: 比较安全的方法就是直 ...
- 用PHPExcel类读取excel文件的内容
这里对PHPExcel类不做介绍,有兴趣的朋友可以自己查阅资料 在classes文件夹下有个PHPExcel.php文件,这个文件是这个类库的主要入口文件,在用之前,要引入这个类 其他的类,在此类中会 ...
- 关于Npoi+excel文件读取,修改文件内容的处理方式
因最近有需求场景,实现对文件的读写操作,又不单独生成新的文件,对于源文件的修改,做了一个简单实现,如下↓ // 要操作的excel文件路径 string fileName = Server.MapPa ...
- vba打开excel文件遍历sheet的名字和指定单元格的值
今天项目上有个应用,获取指定Excel文件下的所有sheet的名称以及当前sheet中指定单元格的值,并把他们写到固定的sheet中去,看了下,文件比较多,而且每个文件sheet的个数比较多,也不一样 ...
随机推荐
- PostgreSQL 学习手册-模式Schema
一个数据库包含一个或多个命名的模式,模式又包含表.模式还包含其它命名的对象,包括数据类型.函数,以及操作符.同一个对象名可以在不同的模式里使用而不会导致冲突: 比如,schema1和myschema都 ...
- svn diff 只显示文件名
svn diff --summarize
- Bacteria (Gym - 101911C)
2018-2019 ACM-ICPC, NEERC, Southern Subregional Contest, Qualification Stage Bacteria Gym - 101911C ...
- redis基准性能测试
1 测试目的 了解redis在不同情况下的性能表现,并分析其性能瓶颈,找出相应的解决方案. 2 redis基准测试概览 运行下列命令可以了解自己的redis服务器的基本性能指标. 通过loopback ...
- jQuery Cookie (内附 上百行的中文使用手册,与 所有的注释中文翻译)
jQuery Cookie (内附 上百行的中文使用手册,与 所有的注释中文翻译) 博主亲自翻译. 大家多多捧场. 更多资源请点击"查看TA 的资源" .全场通通 2积分. htt ...
- Tcl循环语句
for 开始 判断语句 变量自增(自检) 循环体 示例代码: for {set i 0} {$i<10} {incr i} { puts "I is: $i " } 运行结果 ...
- Mac 下反编译Android APK
准备工作:安装ApkTool.dex2jar.JD-GUI 安装ApkTool 1.下载ApkTool.大家可以从 https://ibotpeaches.github.io/Apktool/inst ...
- 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 ...
- case设计及验证:入口+页面+展示
测试个性CB问题, 功能整体结构为:入口+页面+展示 总结: 1. 产品文档为主,其次是服务端接口返回.数据结构及字段值确认.结合实际场景检查是否有遗漏或不合理. 2. 以字段为维度,每个字段的检查点 ...
- -bash: netstat: 未找到命令
[root@localhost ~]# netstat -lunpt -bash: netstat: 未找到命令 [root@localhost ~]# yum -y install net-tool ...